Theory Agent
theory Agent
imports "HOL-Nominal.Nominal"
begin
lemma pt_id:
fixes x :: 'a
and a :: 'x
assumes pt: "pt TYPE('a) TYPE('x)"
and at: "at TYPE('x)"
shows "[(a, a)] ∙ x = x"
proof -
have "x = ([]::'x prm) ∙ x"
by(simp add: pt1[OF pt])
also have "[(a, a)] ∙ x = ([]::'x prm) ∙ x"
by(simp add: pt3[OF pt] at_ds1[OF at])
finally show ?thesis by simp
qed
lemma pt_swap:
fixes x :: 'a
and a :: 'x
and b :: 'x
assumes pt: "pt TYPE('a) TYPE('x)"
and at: "at TYPE('x)"
shows "[(a, b)] ∙ x = [(b, a)] ∙ x"
proof -
show ?thesis by(simp add: pt3[OF pt] at_ds5[OF at])
qed
atom_decl name
lemmas name_fresh_abs = fresh_abs_fun_iff[OF pt_name_inst, OF at_name_inst, OF fs_name1]
lemmas name_bij = at_bij[OF at_name_inst]
lemmas name_supp_abs = abs_fun_supp[OF pt_name_inst, OF at_name_inst, OF fs_name1]
lemmas name_abs_eq = abs_fun_eq[OF pt_name_inst, OF at_name_inst]
lemmas name_supp = at_supp[OF at_name_inst]
lemmas name_calc = at_calc[OF at_name_inst]
lemmas name_fresh_fresh = pt_fresh_fresh[OF pt_name_inst, OF at_name_inst]
lemmas name_fresh_left = pt_fresh_left[OF pt_name_inst, OF at_name_inst]
lemmas name_fresh_right = pt_fresh_right[OF pt_name_inst, OF at_name_inst]
lemmas name_id[simp] = pt_id[OF pt_name_inst, OF at_name_inst]
lemmas name_swap_bij[simp] = pt_swap_bij[OF pt_name_inst, OF at_name_inst]
lemmas name_swap = pt_swap[OF pt_name_inst, OF at_name_inst]
lemmas name_rev_per = pt_rev_pi[OF pt_name_inst, OF at_name_inst]
lemmas name_per_rev = pt_pi_rev[OF pt_name_inst, OF at_name_inst]
lemmas name_exists_fresh = at_exists_fresh[OF at_name_inst, OF fs_name1]
lemmas name_perm_compose = pt_perm_compose[OF pt_name_inst, OF at_name_inst]
nominal_datatype pi = PiNil ("𝟬")
| Output name name pi ("_{_}._" [120, 120, 110] 110)
| Tau pi ("τ._" [120] 110)
| Input name "«name» pi" ("_<_>._" [120, 120, 110] 110)
| Match name name pi ("[_⌢_]_" [120, 120, 110] 110)
| Mismatch name name pi ("[_≠_]_" [120, 120, 110] 110)
| Sum pi pi (infixr "⊕" 90)
| Par pi pi (infixr "∥" 85)
| Res "«name» pi" ("<ν_>_" [100, 100] 100)
| Bang pi ("!_" [110] 110)
lemmas name_fresh[simp] = at_fresh[OF at_name_inst]
lemma alphaInput:
fixes a :: name
and x :: name
and P :: pi
and c :: name
assumes A1: "c ♯ P"
shows "a<x>.P = a<c>.([(x, c)] ∙ P)"
proof(cases "x = c")
assume "x=c"
thus ?thesis by(simp)
next
assume "x ≠ c"
with A1 show ?thesis
by(simp add: pi.inject alpha name_fresh_left name_calc)
qed
lemma alphaRes:
fixes a :: name
and P :: pi
and c :: name
assumes A1: "c ♯ P"
shows "<νa>P = <νc>([(a, c)] ∙ P)"
proof(cases "a=c")
assume "a=c"
thus ?thesis by simp
next
assume "a ≠ c"
with A1 show ?thesis
by(simp add: pi.inject alpha fresh_left name_calc)
qed
definition subst_name :: "name ⇒ name ⇒ name ⇒ name" ("_[_::=_]" [110, 110, 110] 110)
where
"a[b::=c] ≡ if (a = b) then c else a"
declare subst_name_def[simp]
lemma subst_name_eqvt[eqvt]:
fixes p :: "name prm"
and a :: name
and b :: name
and c :: name
shows "p ∙ (a[b::=c]) = (p∙ a)[(p ∙ b)::=(p ∙ c)]"
by(auto simp add: at_bij[OF at_name_inst])
nominal_primrec (freshness_context: "(c::name, d::name)")
subs :: "pi ⇒ name ⇒ name ⇒ pi" ("_[_::=_]" [100,100,100] 100)
where
"𝟬[c::=d] = 𝟬"
| "τ.(P)[c::=d] = τ.(P[c::=d])"
| "a{b}.P[c::=d] = (a[c::=d]){(b[c::=d])}.(P[c::=d])"
| "⟦x ≠ a; x ≠ c; x ≠ d⟧ ⟹ (a<x>.P)[c::=d] = (a[c::=d])<x>.(P[c::=d])"
| "[a⌢b]P[c::=d] = [(a[c::=d])⌢(b[c::=d])](P[c::=d])"
| "[a≠b]P[c::=d] = [(a[c::=d])≠(b[c::=d])](P[c::=d])"
| "(P ⊕ Q)[c::=d] = (P[c::=d]) ⊕ (Q[c::=d])"
| "(P ∥ Q)[c::=d] = (P[c::=d]) ∥ (Q[c::=d])"
| "⟦x ≠ c; x ≠ d⟧ ⟹ (<νx>P)[c::=d] = <νx>(P[c::=d])"
| "!P[c::=d] = !(P[c::=d])"
apply(simp_all add: abs_fresh)
apply(finite_guess)+
by(fresh_guess)+
lemma forget:
fixes a :: name
and P :: pi
and b :: name
assumes "a ♯ P"
shows "P[a::=b] = P"
using assms
by(nominal_induct P avoiding: a b rule: pi.strong_induct)
(auto simp add: name_fresh_abs)
lemma fresh_fact2[rule_format]:
fixes P :: pi
and a :: name
and b :: name
assumes "a ≠ b"
shows "a ♯ P[a::=b]"
using assms
by(nominal_induct P avoiding: a b rule: pi.strong_induct)
(auto simp add: name_fresh_abs)
lemma subst_identity[simp]:
fixes P :: pi
and a :: name
shows "P[a::=a] = P"
by(nominal_induct P avoiding: a rule: pi.strong_induct) auto
lemma renaming:
fixes P :: pi
and a :: name
and b :: name
and c :: name
assumes "c ♯ P"
shows "P[a::=b] = ([(c, a)] ∙ P)[c::=b]"
using assms
by(nominal_induct P avoiding: a b c rule: pi.strong_induct)
(auto simp add: name_calc name_fresh_abs)
lemma fresh_fact1:
fixes P :: pi
and a :: name
and b :: name
and c :: name
assumes "a ♯ P"
and "a ≠ c"
shows "a ♯ P[b::=c]"
using assms
by(nominal_induct P avoiding: a b c rule: pi.strong_induct)
(auto simp add: name_fresh_abs)
lemma eqvt_subs[eqvt]:
fixes p :: "name prm"
and P :: pi
and a :: name
and b :: name
shows "p ∙ (P[a::=b]) = (p ∙ P)[(p ∙ a)::=(p ∙ b)]"
by(nominal_induct P avoiding: a b rule: pi.strong_induct)
(auto simp add: name_bij)
lemma substInput[simp]:
fixes x :: name
and b :: name
and c :: name
and a :: name
and P :: pi
assumes "x ≠ b"
and "x ≠ c"
shows "(a<x>.P)[b::=c] = (a[b::=c])<x>.(P[b::=c])"
proof -
obtain y::name where"y ≠ a" and "y ♯ P" and "y ≠ b" and "y ≠ c"
by(generate_fresh "name") (auto simp add: fresh_prod)
from ‹y ♯ P› have "a<x>.P = a<y>.([(x, y)] ∙ P)" by(simp add: alphaInput)
moreover have "(a[b::=c])<x>.(P[b::=c]) = (a[b::=c])<y>.(([(x, y)] ∙ P)[b::=c])" (is "?LHS = ?RHS")
proof -
from ‹y ♯ P› ‹y ≠ c› have "y ♯ P[b::=c]" by(rule fresh_fact1)
hence "?LHS = (a[b::=c])<y>.([(x, y)] ∙ (P[b::=c]))" by(simp add: alphaInput)
moreover with ‹x ≠ b› ‹x ≠ c› ‹y ≠ b› ‹y ≠ c› have "… = ?RHS"
by(auto simp add: eqvt_subs name_calc)
ultimately show ?thesis by simp
qed
ultimately show ?thesis using ‹y ≠ a› ‹y ≠ b› ‹y ≠ c› by simp
qed
lemma injPermSubst:
fixes P :: pi
and a :: name
and b :: name
assumes "b ♯ P"
shows "[(a, b)] ∙ P = P[a::=b]"
using assms
by(nominal_induct P avoiding: a b rule: pi.strong_induct)
(auto simp add: name_calc name_fresh_abs)
lemma substRes2:
fixes P :: pi
and a :: name
and b :: name
assumes "b ♯ P"
shows "<νa>P = <νb>(P[a::=b])"
proof(case_tac "a = b")
assume "a = b"
thus ?thesis by auto
next
assume "a ≠ b"
moreover with ‹b ♯ P› show ?thesis
apply(simp add: pi.inject abs_fun_eq[OF pt_name_inst, OF at_name_inst])
apply auto
apply(simp add: renaming)
apply(simp add: pt_swap[OF pt_name_inst, OF at_name_inst])
apply(simp add: renaming)
apply(simp add: pt_fresh_left[OF pt_name_inst, OF at_name_inst])
by(force simp add: at_calc[OF at_name_inst])
qed
lemma freshRes:
fixes P :: pi
and a :: name
shows "a ♯ <νa>P"
by(simp add: name_fresh_abs)
lemma substRes3:
fixes P :: pi
and a :: name
and b :: name
assumes "b ♯ P"
shows "(<νa>P)[a::=b] = <νb>(P[a::=b])"
proof -
have "(<νa>P)[a::=b] = <νa>P"
using freshRes by(simp add: forget)
thus ?thesis using ‹b ♯ P› by(simp add: substRes2)
qed
lemma suppSubst:
fixes P :: pi
and a :: name
and b :: name
shows "supp(P[a::=b]) ⊆ insert b ((supp P) - {a})"
apply(nominal_induct P avoiding: a b rule: pi.strong_induct,
simp_all add: pi.supp name_supp_abs name_supp supp_prod)
by(blast)+
primrec seqSubs :: "pi ⇒ (name × name) list ⇒ pi" ("_[<_>]" [100,100] 100) where
"P[<[]>] = P"
| "P[<(x#σ)>] = (P[(fst x)::=(snd x)])[<σ>]"
primrec seq_subst_name :: "name ⇒ (name × name) list ⇒ name" where
"seq_subst_name a [] = a"
| "seq_subst_name a (x#σ) = seq_subst_name (a[(fst x)::=(snd x)]) σ"
lemma freshSeqSubstName:
fixes x :: name
and a :: name
and s :: "(name × name) list"
assumes "x ≠ a"
and "x ♯ s"
shows "x ≠ seq_subst_name a s"
using assms
apply(induct s arbitrary: a)
apply simp
apply(case_tac "aa = fst(a)")
by (force simp add: fresh_list_cons fresh_prod)+
lemma seqSubstZero[simp]:
fixes σ :: "(name × name) list"
shows "𝟬[<σ>] = 𝟬"
by(induct σ, auto)
lemma seqSubstTau[simp]:
fixes P :: pi
and σ :: "(name × name) list"
shows "(τ.(P))[<σ>] = τ.(P[<σ>])"
by(induct σ arbitrary: P, auto)
lemma seqSubstOutput[simp]:
fixes a :: name
and b :: name
and P :: pi
and σ :: "(name × name) list"
shows "(a{b}.P)[<σ>] = (seq_subst_name a σ){(seq_subst_name b σ)}.(P[<σ>])"
by(induct σ arbitrary: a b P, auto)
lemma seqSubstInput[simp]:
fixes a :: name
and x :: name
and P :: pi
and σ :: "(name × name) list"
assumes "x ♯ σ"
shows "(a<x>.P)[<σ>] = (seq_subst_name a σ)<x>.(P[<σ>])"
using assms
by(induct σ arbitrary: a x P) (auto simp add: fresh_list_cons fresh_prod)
lemma seqSubstMatch[simp]:
fixes a :: name
and b :: name
and P :: pi
and σ :: "(name × name) list"
shows "([a⌢b]P)[<σ>] = [(seq_subst_name a σ)⌢(seq_subst_name b σ)](P[<σ>])"
by(induct σ arbitrary: a b P, auto)
lemma seqSubstMismatch[simp]:
fixes a :: name
and b :: name
and P :: pi
and σ :: "(name × name) list"
shows "([a≠b]P)[<σ>] = [(seq_subst_name a σ)≠(seq_subst_name b σ)](P[<σ>])"
by(induct σ arbitrary: a b P, auto)
lemma seqSubstSum[simp]:
fixes P :: pi
and Q :: pi
and σ :: "(name × name) list"
shows "(P ⊕ Q)[<σ>] = (P[<σ>]) ⊕ (Q[<σ>])"
by(induct σ arbitrary: P Q , auto)
lemma seqSubstPar[simp]:
fixes P :: pi
and Q :: pi
and σ :: "(name × name) list"
shows "(P ∥ Q)[<σ>] = (P[<σ>]) ∥ (Q[<σ>])"
by(induct σ arbitrary: P Q, auto)
lemma seqSubstRes[simp]:
fixes x :: name
and P :: pi
and σ :: "(name × name) list"
assumes "x ♯ σ"
shows "(<νx>P)[<σ>] = <νx>(P[<σ>])"
using assms
by(induct σ arbitrary: x P) (auto simp add: fresh_list_cons fresh_prod)
lemma seqSubstBang[simp]:
fixes P :: pi
and s :: "(name × name) list"
shows "(!P)[<σ>] = !(P[<σ>])"
by(induct σ arbitrary: P, auto)
lemma seqSubstEqvt[eqvt, simp]:
fixes P :: pi
and σ :: "(name × name) list"
and p :: "name prm"
shows "p ∙ (P[<σ>]) = (p ∙ P)[<(p ∙ σ)>]"
by(induct σ arbitrary: P, auto simp add: eqvt_subs)
lemma seqSubstAppend[simp]:
fixes P :: pi
and σ :: "(name × name) list"
and σ' :: "(name × name) list"
shows "P[<(σ@σ')>] = (P[<σ>])[<σ'>]"
by(induct σ arbitrary: P, auto)
lemma freshSubstChain[intro]:
fixes P :: pi
and σ :: "(name × name) list"
and a :: name
assumes "a ♯ P"
and "a ♯ σ"
shows "a ♯ P[<σ>]"
using assms
by(induct σ arbitrary: a P, auto simp add: fresh_list_cons fresh_prod fresh_fact1)
end
Theory Late_Semantics
theory Late_Semantics
imports Agent
begin
nominal_datatype subject = InputS name
| BoundOutputS name
nominal_datatype freeRes = OutputR name name ("_[_]" [130, 130] 110)
| TauR ("τ" 130)
nominal_datatype residual = BoundR subject "«name» pi" ("_«_» ≺ _" [80, 80, 80] 80)
| FreeR freeRes pi ("_ ≺ _" [80, 80] 80)
lemmas residualInject = residual.inject freeRes.inject subject.inject
abbreviation "Transitions_Inputjudge" :: "name ⇒ name ⇒ pi ⇒ residual" ("_<_> ≺ _" [80, 80, 80] 80)
where "a<x> ≺ P' ≡ ((InputS a)«x» ≺ P')"
abbreviation "Transitions_BoundOutputjudge" :: "name ⇒ name ⇒ pi ⇒ residual" ("_<ν_> ≺ _" [80, 80, 80] 80)
where "a<νx> ≺ P' ≡ (BoundR (BoundOutputS a) x P')"
inductive transitions :: "pi ⇒ residual ⇒ bool" ("_ ⟼ _" [80, 80] 80)
where
Tau: "τ.(P) ⟼ τ ≺ P"
| Input: "x ≠ a ⟹ a<x>.P ⟼ a<x> ≺ P"
| Output: "a{b}.P ⟼ a[b] ≺ P"
| Match: "⟦P ⟼ Rs⟧ ⟹ [b⌢b]P ⟼ Rs"
| Mismatch: "⟦P ⟼ Rs; a ≠ b⟧ ⟹ [a≠b]P ⟼ Rs"
| Open: "⟦P ⟼ a[b] ≺ P'; a ≠ b⟧ ⟹ <νb>P ⟼ a<νb> ≺ P'"
| Sum1: "⟦P ⟼ Rs⟧ ⟹ (P ⊕ Q) ⟼ Rs"
| Sum2: "⟦Q ⟼ Rs⟧ ⟹ (P ⊕ Q) ⟼ Rs"
| Par1B: "⟦P ⟼ a«x» ≺ P'; x ♯ P; x ♯ Q; x ♯ a⟧ ⟹ P ∥ Q ⟼ a«x» ≺ (P' ∥ Q)"
| Par1F: "⟦P ⟼ α ≺ P'⟧ ⟹ P ∥ Q ⟼ α ≺ (P' ∥ Q)"
| Par2B: "⟦Q ⟼ a«x» ≺ Q'; x ♯ P; x ♯ Q; x ♯ a⟧ ⟹ P ∥ Q ⟼ a«x» ≺ (P ∥ Q')"
| Par2F: "⟦Q ⟼ α ≺ Q'⟧ ⟹ P ∥ Q ⟼ α ≺ (P ∥ Q')"
| Comm1: "⟦P ⟼ a<x> ≺ P'; Q ⟼ a[b] ≺ Q'; x ♯ P; x ♯ Q; x ≠ a; x ≠ b; x ♯ Q'⟧ ⟹ P ∥ Q ⟼ τ ≺ P'[x::=b] ∥ Q'"
| Comm2: "⟦P ⟼ a[b] ≺ P'; Q ⟼ a<x> ≺ Q'; x ♯ P; x ♯ Q; x ≠ a; x ≠ b; x ♯ P'⟧ ⟹ P ∥ Q ⟼ τ ≺ P' ∥ Q'[x::=b]"
| Close1: "⟦P ⟼ a<x> ≺ P'; Q ⟼ a<νy> ≺ Q'; x ♯ P; x ♯ Q; y ♯ P;
y ♯ Q; x ≠ a; x ♯ Q'; y ≠ a; y ♯ P'; x ≠ y⟧ ⟹ P ∥ Q ⟼ τ ≺ <νy>(P'[x::=y] ∥ Q')"
| Close2: "⟦P ⟼ a<νy> ≺ P'; Q ⟼ a<x> ≺ Q'; x ♯ P; x ♯ Q; y ♯ P;
y ♯ Q; x ≠ a; x ♯ P'; y ≠ a; y ♯ Q'; x ≠ y⟧ ⟹ P ∥ Q ⟼ τ ≺ <νy>(P' ∥ Q'[x::=y])"
| ResB: "⟦P ⟼ a«x» ≺ P'; y ♯ a; y ≠ x; x ♯ P; x ♯ a⟧ ⟹ <νy>P ⟼ a«x» ≺ <νy>P'"
| ResF: "⟦P ⟼ α ≺ P'; y ♯ α⟧ ⟹ <νy>P ⟼ α ≺ <νy>P'"
| Bang: "⟦P ∥ !P ⟼ Rs⟧ ⟹ !P ⟼ Rs"
equivariance transitions
nominal_inductive transitions
by(auto simp add: abs_fresh fresh_fact2)
lemma alphaBoundResidual:
fixes a :: subject
and x :: name
and P :: pi
and x' :: name
assumes A1: "x' ♯ P"
shows "a«x» ≺ P = a«x'» ≺ ([(x, x')] ∙ P)"
proof(cases "x=x'")
assume "x=x'"
thus ?thesis by simp
next
assume "x ≠ x'"
with A1 show ?thesis
by(simp add: residualInject alpha name_fresh_left name_calc)
qed
lemma freshResidual:
fixes P :: pi
and Rs :: residual
and x :: name
assumes "P ⟼ Rs"
and "x ♯ P"
shows "x ♯ Rs"
using assms
by(nominal_induct rule: transitions.strong_induct)
(auto simp add: abs_fresh fresh_fact2 fresh_fact1)
lemma freshBoundDerivative:
assumes "P ⟼a«x» ≺ P'"
and "y ♯ P"
shows "y ♯ a"
and "y ≠ x ⟹ y ♯ P'"
apply -
using assms
by(fastforce dest: freshResidual simp add: abs_fresh)+
lemma freshFreeDerivative:
fixes P :: pi
and α :: freeRes
and P' :: pi
and y :: name
assumes "P ⟼α ≺ P'"
and "y ♯ P"
shows "y ♯ α"
and "y ♯ P'"
apply -
using assms
by(fastforce dest: freshResidual)+
lemma substTrans[simp]:
fixes b :: name
and P :: pi
and a :: name
and c :: name
assumes "b ♯ P"
shows "(P[a::=b])[b::=c] = P[a::=c]"
using assms
apply(simp add: injPermSubst[THEN sym])
apply(simp add: renaming)
by(simp add: pt_swap[OF pt_name_inst, OF at_name_inst])
lemma Input:
fixes a :: name
and x :: name
and P :: pi
shows "a<x>.P ⟼a<x> ≺ P"
proof -
obtain y::name where "y ≠ a" and "y ♯ P"
by(generate_fresh "name", auto simp add: fresh_prod)
from ‹y ♯ P› have "a<x>.P = a<y>.([(x, y)] ∙ P)" and "a<x> ≺ P = a<y> ≺ ([(x, y)] ∙ P)"
by(auto simp add: alphaBoundResidual alphaInput)
with ‹y ≠ a› show ?thesis by(force intro: Input)
qed
declare perm_fresh_fresh[simp] name_swap[simp] fresh_prod[simp]
lemma Par1B:
fixes P :: pi
and a :: subject
and x :: name
and P' :: pi
and Q :: pi
assumes "P ⟼a«x» ≺ P'"
and "x ♯ Q"
shows "P ∥ Q ⟼a«x» ≺ P' ∥ Q"
proof -
obtain y::name where "y ♯ P" and "y ♯ P'" and "y ♯ Q" and "y ♯ a"
by(generate_fresh "name", auto)
from ‹P ⟼ a«x» ≺ P'› ‹y ♯ P'› have "P ⟼a«y» ≺ ([(x, y)] ∙ P')"
by(simp add: alphaBoundResidual)
hence "P ∥ Q ⟼a«y» ≺ ([(x, y)] ∙ P') ∥ Q" using ‹y ♯ P› ‹y ♯ Q› ‹y ♯ a›
by(rule Par1B)
with ‹x ♯ Q› ‹y ♯ P'› ‹y ♯ Q› show ?thesis
by(subst alphaBoundResidual[where x'=y]) auto
qed
lemma Par2B:
fixes Q :: pi
and a :: subject
and x :: name
and Q' :: pi
and P :: pi
assumes QTrans: "Q ⟼a«x» ≺ Q'"
and "x ♯ P"
shows "P ∥ Q ⟼a«x» ≺ P ∥ Q'"
proof -
obtain y::name where "y ♯ Q" and "y ♯ Q'" and "y ♯ P" and "y ♯ a"
by(generate_fresh "name", auto simp add: fresh_prod)
from QTrans ‹y ♯ Q'› have "Q ⟼a«y» ≺ ([(x, y)] ∙ Q')"
by(simp add:alphaBoundResidual)
hence "P ∥ Q ⟼a«y» ≺ P ∥ ([(x, y)] ∙ Q')" using ‹y ♯ P› ‹y ♯ Q› ‹y ♯ a›
by(rule Par2B)
moreover have "a«y» ≺ P ∥ ([(x, y)] ∙ Q') = a«x» ≺ P ∥ Q'"
proof -
from ‹y ♯ Q'› ‹x ♯ P› have "x ♯ P ∥ ([(x, y)] ∙ Q')" by(auto simp add: calc_atm fresh_left)
with ‹x ♯ P› ‹y ♯ P› show ?thesis by(simp only: alphaBoundResidual, auto simp add: name_swap name_fresh_fresh)
qed
ultimately show ?thesis by simp
qed
lemma Comm1:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
and Q :: pi
and b :: name
and Q' :: pi
assumes PTrans: "P ⟼a<x> ≺ P'"
and QTrans: "Q ⟼a[b] ≺ Q'"
shows "P ∥ Q ⟼τ ≺ P'[x::=b] ∥ Q'"
proof -
obtain y::name where "y ♯ P" and "y ♯ P'" and "y ♯ Q" and "y ≠ a" and "y ≠ b" and "y ♯ Q'"
by(generate_fresh "name", auto simp add: fresh_prod)
from PTrans ‹y ♯ P'› have "P ⟼a<y> ≺ ([(x, y)] ∙ P')"
by(simp add: alphaBoundResidual)
hence "P ∥ Q ⟼τ ≺ ([(x, y)] ∙ P')[y::=b] ∥ Q'"
using QTrans ‹y ♯ P› ‹y ♯ Q› ‹y ≠ a› ‹y ≠ b› ‹y ♯ Q'›
by(rule Comm1)
with ‹y ♯ P'› show ?thesis by(simp add: renaming name_swap)
qed
lemma Comm2:
fixes P :: pi
and a :: name
and b :: name
and P' :: pi
and Q :: pi
and x :: name
and Q' :: pi
assumes PTrans: "P ⟼a[b] ≺ P'"
and QTrans: "Q ⟼a<x> ≺ Q'"
shows "P ∥ Q ⟼τ ≺ P' ∥ (Q'[x::=b])"
proof -
obtain y::name where "y ♯ P" and "y ♯ P'" and "y ♯ Q" and "y ≠ a" and "y ≠ b" and "y ♯ Q'"
by(generate_fresh "name", auto simp add: fresh_prod)
from QTrans ‹y ♯ Q'› have "Q ⟼a<y> ≺ ([(x, y)] ∙ Q')"
by(simp add: alphaBoundResidual)
with PTrans have "P ∥ Q ⟼τ ≺ P' ∥ (([(x, y)] ∙ Q')[y::=b])"
using ‹y ♯ P› ‹y ♯ Q› ‹y ≠ a› ‹y ≠ b› ‹y ♯ P'›
by(rule Comm2)
with ‹y ♯ Q'› show ?thesis by(simp add: renaming name_swap)
qed
lemma Close1:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
and Q :: pi
and y :: name
and Q' :: pi
assumes PTrans: "P ⟼a<x> ≺ P'"
and QTrans: "Q ⟼a<νy> ≺ Q'"
and "y ♯ P"
shows "P ∥ Q ⟼τ ≺ <νy>(P'[x::=y] ∥ Q')"
proof -
obtain x'::name where "x' ♯ P" and "x' ♯ P'" and "x' ♯ Q" and "x' ♯ Q'" and "x' ≠ a"
by(generate_fresh "name", auto simp add: fresh_prod)
obtain y'::name where "y' ♯ P" and "y' ♯ Q'" and "y' ♯ Q"
and "y' ♯ P'" and "y' ≠ x'" and "y' ≠ y" and "y' ≠ a"
by(generate_fresh "name", auto simp add: fresh_prod)
from PTrans ‹x' ♯ P'› have "P ⟼a<x'> ≺ ([(x, x')] ∙ P')"
by(simp add: alphaBoundResidual)
moreover from QTrans ‹y' ♯ Q'› have "Q ⟼a<νy'> ≺ ([(y, y')] ∙ Q')"
by(simp add: alphaBoundResidual)
ultimately have "P ∥ Q ⟼τ ≺ <νy'>(([(x, x')] ∙ P')[x'::=y'] ∥ ([(y, y')] ∙ Q'))"
using ‹y' ♯ P› ‹y' ♯ Q› ‹x' ♯ P› ‹x' ♯ Q› ‹y' ≠ x'› ‹y' ≠ a› ‹x' ≠ a›
‹y' ♯ P'› ‹y' ♯ Q'› ‹x' ♯ P'› ‹x' ♯ Q'›
apply(rule_tac Close1)
by assumption (auto simp add: fresh_left calc_atm)
moreover have "<νy'>(([(x, x')] ∙ P')[x'::=y'] ∥ ([(y, y')] ∙ Q')) = <νy>(P'[x::=y] ∥ Q')"
proof -
from ‹x' ♯ P'› have "([(x, x')] ∙ P')[x'::=y'] = P'[x::=y']" by(simp add: renaming name_swap)
moreover have "y ♯ (P'[x::=y'] ∥ ([(y, y')] ∙ Q'))"
proof(case_tac "y = x")
assume "y = x"
with ‹y' ♯ Q'› ‹y' ≠ y› show ?thesis by(auto simp add: fresh_fact2 fresh_left calc_atm)
next
assume "y ≠ x"
with ‹y ♯ P› PTrans have "y ♯ P'" by(force dest: freshBoundDerivative)
with ‹y' ♯ Q'› ‹y' ≠ y› show ?thesis by(auto simp add: fresh_left calc_atm fresh_fact1)
qed
ultimately show ?thesis using ‹y' ♯ P'› apply(simp only: alphaRes)
by(auto simp add: name_swap eqvt_subs calc_atm renaming)
qed
ultimately show ?thesis by simp
qed
lemma Close2:
fixes P :: pi
and a :: name
and y :: name
and P' :: pi
and Q :: pi
and x :: name
and Q' :: pi
assumes PTrans: "P ⟼a<νy> ≺ P'"
and QTrans: "Q ⟼a<x> ≺ Q'"
and "y ♯ Q"
shows "P ∥ Q ⟼τ ≺ <νy>(P' ∥ (Q'[x::=y]))"
proof -
obtain x'::name where "x' ♯ P" and "x' ♯ Q'" and "x' ♯ Q" and "x' ♯ P'" and "x' ≠ a"
by(generate_fresh "name", auto simp add: fresh_prod)
obtain y'::name where "y' ♯ P" and "y' ♯ P'" and "y' ♯ Q"
and "y' ♯ Q'" and "y' ≠ x'" and "y' ≠ y" and "y' ≠ a"
by(generate_fresh "name", auto simp add: fresh_prod)
from PTrans ‹y' ♯ P'› have "P ⟼a<νy'> ≺ ([(y, y')] ∙ P')"
by(simp add: alphaBoundResidual)
moreover from QTrans ‹x' ♯ Q'› have "Q ⟼a<x'> ≺ ([(x, x')] ∙ Q')"
by(simp add: alphaBoundResidual)
ultimately have "P ∥ Q ⟼τ ≺ <νy'>(([(y, y')] ∙ P') ∥ (([(x, x')] ∙ Q')[x'::=y']))"
using ‹y' ♯ P› ‹y' ♯ Q› ‹x' ♯ P› ‹x' ♯ Q› ‹y' ≠ x'› ‹x' ≠ a› ‹y' ≠ a›
‹x' ♯ P'› ‹x' ♯ Q'› ‹y' ♯ P'› ‹y' ♯ Q'›
by(rule_tac Close2) (assumption | auto simp add: fresh_left calc_atm)+
moreover have "<νy'>(([(y, y')] ∙ P') ∥ (([(x, x')] ∙ Q')[x'::=y'])) = <νy>(P' ∥ (Q'[x::=y]))"
proof -
from ‹x' ♯ Q'› have "([(x, x')] ∙ Q')[x'::=y'] = Q'[x::=y']" by(simp add: renaming name_swap)
moreover have "y ♯ (([(y, y')] ∙ P') ∥ (Q'[x::=y']))"
proof(case_tac "y = x")
assume "y = x"
with ‹y' ♯ P'› ‹y' ≠ y› show ?thesis by(auto simp add: fresh_fact2 fresh_left calc_atm)
next
assume "y ≠ x"
with ‹y ♯ Q› QTrans have "y ♯ Q'" by(force dest: freshBoundDerivative)
with ‹y' ♯ P'› ‹y' ≠ y› show ?thesis by(auto simp add: fresh_left calc_atm fresh_fact1)
qed
ultimately show ?thesis using ‹y' ♯ Q'› apply(simp only: alphaRes)
by(auto simp add: name_swap eqvt_subs calc_atm renaming)
qed
ultimately show ?thesis by simp
qed
lemma ResB:
fixes P :: pi
and a :: subject
and x :: name
and P' :: pi
and y :: name
assumes PTrans: "P ⟼a«x» ≺ P'"
and "y ♯ a"
and "y ≠ x"
shows "<νy>P ⟼a«x» ≺ <νy>P'"
proof -
obtain z where "z ♯ P" and "z ♯ a" and "z ≠ y" and "z ♯ P'"
by(generate_fresh "name", auto simp add: fresh_prod)
from PTrans ‹z ♯ P'› have "P ⟼a«z» ≺ ([(x, z)] ∙ P')" by(simp add: alphaBoundResidual)
with ‹z ♯ P› ‹z ♯ a› ‹z ≠ y› ‹y ♯ a› have "<νy>P ⟼a«z» ≺ <νy>([(x, z)] ∙ P')" by(rule_tac ResB) auto
moreover have "a«z» ≺ <νy>([(x, z)] ∙ P') = a«x» ≺ <νy>P'"
proof -
from ‹z ♯ P'› ‹y ≠ x› have "x ♯ <νy>([(x, z)] ∙ P')" by(auto simp add: abs_fresh fresh_left calc_atm)
with ‹y ≠ x› ‹z ≠ y› show ?thesis by(simp add: alphaBoundResidual name_swap calc_atm)
qed
ultimately show ?thesis by simp
qed
lemma outputInduct[consumes 1, case_names Output Match Mismatch Sum1 Sum2 Par1 Par2 Res Bang]:
fixes P :: pi
and a :: name
and b :: name
and P' :: pi
and F :: "'a::fs_name ⇒ pi ⇒ name ⇒ name ⇒ pi ⇒ bool"
and C :: "'a::fs_name"
assumes Trans: "P ⟼a[b] ≺ P'"
and "⋀a b P C. F C (a{b}.P) a b P"
and "⋀P a b P' c C. ⟦P ⟼OutputR a b ≺ P'; ⋀C. F C P a b P'⟧ ⟹ F C ([c⌢c]P) a b P'"
and "⋀P a b P' c d C. ⟦P ⟼OutputR a b ≺ P'; ⋀C. F C P a b P'; c ≠ d⟧ ⟹ F C ([c≠d]P) a b P'"
and "⋀P a b P' Q C. ⟦P ⟼OutputR a b ≺ P'; ⋀C. F C P a b P'⟧ ⟹ F C (P ⊕ Q) a b P'"
and "⋀Q a b Q' P C. ⟦Q ⟼OutputR a b ≺ Q'; ⋀C. F C Q a b Q'⟧ ⟹ F C (P ⊕ Q) a b Q'"
and "⋀P a b P' Q C. ⟦P ⟼OutputR a b ≺ P'; ⋀C. F C P a b P'⟧ ⟹ F C (P ∥ Q) a b (P' ∥ Q)"
and "⋀Q a b Q' P C. ⟦Q ⟼OutputR a b ≺ Q'; ⋀C. F C Q a b Q'⟧ ⟹ F C (P ∥ Q) a b (P ∥ Q')"
and "⋀P a b P' x C. ⟦P ⟼OutputR a b ≺ P'; x ≠ a; x ≠ b; x ♯ C; ⋀C. F C P a b P'⟧ ⟹
F C (<νx>P) a b (<νx>P')"
and "⋀P a b P' C. ⟦P ∥ !P ⟼OutputR a b ≺ P'; ⋀C. F C (P ∥ !P) a b P'⟧ ⟹ F C (!P) a b P'"
shows "F C P a b P'"
proof -
from Trans show ?thesis
by(nominal_induct x2 == "OutputR a b ≺ P'" avoiding: C arbitrary: P' rule: transitions.strong_induct,
auto simp add: residualInject freeRes.inject intro: assms)
qed
lemma inputInduct[consumes 2, case_names Input Match Mismatch Sum1 Sum2 Par1 Par2 Res Bang]:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
and F :: "('a::fs_name) ⇒ pi ⇒ name ⇒ name ⇒ pi ⇒ bool"
and C :: "'a::fs_name"
assumes a: "P ⟼a<x> ≺ P'"
and "x ♯ P"
and cInput: "⋀a x P C. F C (a<x>.P) a x P"
and cMatch: "⋀P a x P' b C. ⟦P ⟼a<x> ≺ P'; ⋀C. F C P a x P'⟧ ⟹ F C ([b⌢b]P) a x P'"
and cMismatch: "⋀P a x P' b c C. ⟦P ⟼a<x> ≺ P'; ⋀C. F C P a x P'; b ≠ c⟧ ⟹ F C ([b≠c]P) a x P'"
and cSum1: "⋀P Q a x P' C. ⟦P ⟼a<x> ≺ P'; ⋀C. F C P a x P'⟧ ⟹ F C (P ⊕ Q) a x P'"
and cSum2: "⋀P Q a x Q' C. ⟦Q ⟼a<x> ≺ Q'; ⋀C. F C Q a x Q'⟧ ⟹ F C (P ⊕ Q) a x Q'"
and cPar1B: "⋀P P' Q a x C. ⟦P ⟼a<x> ≺ P'; x ♯ P; x ♯ Q; x ≠ a; ⋀C. F C P a x P'⟧ ⟹
F C (P ∥ Q) a x (P' ∥ Q)"
and cPar2B: "⋀P Q Q' a x C. ⟦Q ⟼a<x> ≺ Q'; x ♯ P; x ♯ Q; x ≠ a; ⋀C. F C Q a x Q'⟧ ⟹
F C (P ∥ Q) a x (P ∥ Q')"
and cResB: "⋀P P' a x y C. ⟦P ⟼a<x> ≺ P'; y ≠ a; y ≠ x; y ♯ C;
⋀C. F C P a x P'⟧ ⟹ F C (<νy>P) a x (<νy>P')"
and cBang: "⋀P a x P' C. ⟦P ∥ !P ⟼a<x> ≺ P'; ⋀C. F C (P ∥ !P) a x P'⟧ ⟹
F C (!P) a x P'"
shows "F C P a x P'"
proof -
from a ‹x ♯ P› show ?thesis
proof(nominal_induct x2 == "a<x> ≺ P'" avoiding: C a x P' rule: transitions.strong_induct)
case(Tau P)
thus ?case by(simp add: residualInject)
next
case(Input x a P C a' x' P')
have "x ♯ x'" by fact hence "x ≠ x'" by simp
moreover have "a<x> ≺ P = a'<x'> ≺ P'" by fact
ultimately have aeqa': "a = a'" and PeqP': "P = [(x, x')] ∙ P'"
by(simp add: residualInject freeRes.inject subject.inject name_abs_eq)+
have "F C (a<x'>.([(x, x')] ∙ P)) a x' ([(x, x')] ∙ P)" by(rule cInput)
moreover have "x ♯ P'" by fact
ultimately show ?case using PeqP' aeqa' by(simp add: alphaInput name_swap)
next
case(Output P a b)
thus ?case by(simp add: residualInject)
next
case(Match P b Rs a x)
thus ?case
by(force intro: cMatch simp add: residualInject)
next
case(Mismatch P Rs a b C a x)
thus ?case
by(force intro: cMismatch simp add: residualInject)
next
case(Open P P' a b C a' x P')
thus ?case by(simp add: residualInject)
next
case(Sum1 P Q Rs C)
thus ?case by(force intro: cSum1)
next
case(Sum2 P Q Rs C)
thus ?case by(force intro: cSum2)
next
case(Par1B P a x P' Q C a' x' P'')
have "x ♯ x'" by fact hence xineqx': "x ≠ x'" by simp
moreover have Eq: "a«x» ≺ (P' ∥ Q) = a'<x'> ≺ P''" by fact
hence aeqa': "a = InputS a'" by(simp add: residualInject)
have "x' ♯ P ∥ Q" by fact
hence "x' ♯ P" and "x' ♯ Q" by simp+
have P''eq: "P'' = ([(x, x')] ∙ P') ∥ Q"
proof -
from Eq xineqx' have "(P' ∥ Q) = [(x, x')] ∙ P''"
by(simp add: residualInject name_abs_eq)
hence "([(x, x')] ∙ (P' ∥ Q)) = P''" by simp
with ‹x' ♯ Q›‹x ♯ Q› show ?thesis by(simp add: name_fresh_fresh)
qed
have "x ♯ P''" by fact
with P''eq ‹x ≠ x'› have "x' ♯ P'" by(simp add: name_fresh_left name_calc)
have PTrans: "P ⟼a«x» ≺ P'" by fact
with ‹x' ♯ P'› aeqa' have "P ⟼a'<x'> ≺ ([(x, x')] ∙ P')"
by(simp add: alphaBoundResidual)
moreover have "⋀C. F C P a' x' ([(x, x')] ∙ P')"
proof -
fix C
have "⋀C a' x' P''. ⟦a«x» ≺ P' = a'<x'> ≺ P''; x' ♯ P⟧ ⟹ F C P a' x' P''" by fact
moreover with aeqa' xineqx' ‹x' ♯ P'› have "a«x» ≺ P' = a'<x'> ≺ ([(x, x')] ∙ P')"
by(simp add: residualInject name_abs_eq name_fresh_left name_calc)
ultimately show "F C P a' x' ([(x, x')] ∙ P')" using ‹x' ♯ P› by blast
qed
moreover from PTrans ‹x' ♯ P› have "x' ♯ a" by(auto dest: freshBoundDerivative)
ultimately have "F C (P ∥ Q) a' x' (([(x, x')] ∙ P') ∥ Q)" using ‹x' ♯ Q›aeqa' ‹x' ♯ P›
by(rule_tac cPar1B) auto
with P''eq show ?case by simp
next
case(Par1F P P' Q α)
thus ?case by(simp add: residualInject)
next
case(Par2B Q a x Q' P C a' x' Q'')
have "x ♯ x'" by fact hence xineqx': "x ≠ x'" by simp
moreover have Eq: "a«x» ≺ (P ∥ Q') = a'<x'> ≺ Q''" by fact
hence aeqa': "a = InputS a'" by(simp add: residualInject)
have "x ♯ P" by fact
have "x' ♯ P ∥ Q" by fact
hence "x' ♯ P" and "x' ♯ Q" by simp+
have Q''eq: "Q'' = P ∥ ([(x, x')] ∙ Q')"
proof -
from Eq xineqx' have "(P ∥ Q') = [(x, x')] ∙ Q''"
by(simp add: residualInject name_abs_eq)
hence "([(x, x')] ∙ (P ∥ Q')) = Q''" by simp
with ‹x' ♯ P› ‹x ♯ P› show ?thesis by(simp add: name_fresh_fresh)
qed
have "x ♯ Q''" by fact
with Q''eq ‹x ≠ x'› have "x' ♯ Q'" by(simp add: name_fresh_left name_calc)
have QTrans: "Q ⟼a«x» ≺ Q'" by fact
with ‹x' ♯ Q'› aeqa' have "Q ⟼a'<x'> ≺ ([(x, x')] ∙ Q')"
by(simp add: alphaBoundResidual)
moreover have "⋀C. F C Q a' x' ([(x, x')] ∙ Q')"
proof -
fix C
have "⋀C a' x' Q''. ⟦a«x» ≺ Q' = a'<x'> ≺ Q''; x' ♯ Q⟧ ⟹ F C Q a' x' Q''" by fact
moreover with aeqa' xineqx' ‹x' ♯ Q'› have "a«x» ≺ Q' = a'<x'> ≺ ([(x, x')] ∙ Q')"
by(simp add: residualInject name_abs_eq name_fresh_left name_calc)
ultimately show "F C Q a' x' ([(x, x')] ∙ Q')" using ‹x' ♯ Q›aeqa' by blast
qed
moreover from QTrans ‹x' ♯ Q› have "x' ♯ a" by(force dest: freshBoundDerivative)
ultimately have "F C (P ∥ Q) a' x' (P ∥ ([(x, x')] ∙ Q'))" using ‹x' ♯ P› aeqa' ‹x' ♯ Q›
by(rule_tac cPar2B) auto
with Q''eq show ?case by simp
next
case(Par2F P P' Q α)
thus ?case by(simp add: residualInject)
next
case(Comm1 P P' Q Q' a b x)
thus ?case by(simp add: residualInject)
next
case(Comm2 P P' Q Q' a b x)
thus ?case by(simp add: residualInject)
next
case(Close1 P P' Q Q' a x y)
thus ?case by(simp add: residualInject)
next
case(Close2 P P' Q Q' a x y)
thus ?case by(simp add: residualInject)
next
case(ResB P a x P' y C a' x' P'')
have "x ♯ x'" by fact hence xineqx': "x ≠ x'" by simp
moreover have Eq: "a«x» ≺ (<νy>P') = a'<x'> ≺ P''" by fact
hence aeqa': "a = InputS a'" by(simp add: residualInject)
have "y ♯ x'" by fact hence yineqx': "y ≠ x'" by simp
moreover have "x' ♯ <νy>P" by fact
ultimately have "x' ♯ P" by(simp add: name_fresh_abs)
have "y ≠ x" and yineqa: "y ♯ a" and yFreshC: "y ♯ C" by fact+
have P''eq: "P'' = <νy>([(x, x')] ∙ P')"
proof -
from Eq xineqx' have "<νy>P' = [(x, x')] ∙ P''"
by(simp add: residualInject name_abs_eq)
hence "([(x, x')] ∙ (<νy>P')) = P''" by simp
with yineqx' ‹y ≠ x› show ?thesis by(simp add: name_fresh_fresh)
qed
have "x ♯ P''" by fact
with P''eq ‹y ≠ x› ‹x ≠ x'› have "x' ♯ P'" by(simp add: name_fresh_left name_calc name_fresh_abs)
have "P ⟼a«x» ≺ P'" by fact
with ‹x' ♯ P'› aeqa' have "P ⟼a'<x'> ≺ ([(x, x')] ∙ P')"
by(simp add: alphaBoundResidual)
moreover have "⋀C. F C P a' x' ([(x, x')] ∙ P')"
proof -
fix C
have "⋀C a' x' P''. ⟦a«x» ≺ P' = a'<x'> ≺ P''; x' ♯ P⟧ ⟹ F C P a' x' P''" by fact
moreover with aeqa' xineqx' ‹x' ♯ P'› have "a«x» ≺ P' = a'<x'> ≺ ([(x, x')] ∙ P')"
by(simp add: residualInject name_abs_eq name_fresh_left name_calc)
ultimately show "F C P a' x' ([(x, x')] ∙ P')" using ‹x' ♯ P› aeqa' by blast
qed
ultimately have "F C (<νy>P) a' x' (<νy>([(x, x')] ∙ P'))" using yineqx' yineqa yFreshC aeqa'
by(force intro: cResB)
with P''eq show ?case by simp
next
case(ResF P P' α y)
thus ?case by(simp add: residualInject)
next
case(Bang P Rs)
thus ?case by(force intro: cBang)
qed
qed
lemma boundOutputInduct[consumes 2, case_names Match Mismatch Open Sum1 Sum2 Par1 Par2 Res Bang]:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
and F :: "('a::fs_name) ⇒ pi ⇒ name ⇒ name ⇒ pi ⇒ bool"
and C :: "'a::fs_name"
assumes a: "P ⟼a<νx> ≺ P'"
and "x ♯ P"
and cMatch: "⋀P a x P' b C. ⟦P ⟼a<νx> ≺ P'; ⋀C. F C P a x P'⟧ ⟹ F C ([b⌢b]P) a x P'"
and cMismatch: "⋀P a x P' b c C. ⟦P ⟼a<νx> ≺ P'; ⋀C. F C P a x P'; b ≠ c⟧ ⟹ F C ([b≠c]P) a x P'"
and cOpen: "⋀P a x P' C. ⟦P ⟼(OutputR a x) ≺ P'; a ≠ x⟧ ⟹ F C (<νx>P) a x P'"
and cSum1: "⋀P Q a x P' C. ⟦P ⟼a<νx> ≺ P'; ⋀C. F C P a x P'⟧ ⟹ F C (P ⊕ Q) a x P'"
and cSum2: "⋀P Q a x Q' C. ⟦Q ⟼a<νx> ≺ Q'; ⋀C. F C Q a x Q'⟧ ⟹ F C (P ⊕ Q) a x Q'"
and cPar1B: "⋀P P' Q a x C. ⟦P ⟼a<νx> ≺ P'; x ♯ Q; ⋀C. F C P a x P'⟧ ⟹
F C (P ∥ Q) a x (P' ∥ Q)"
and cPar2B: "⋀P Q Q' a x C. ⟦Q ⟼a<νx> ≺ Q'; x ♯ P; ⋀C. F C Q a x Q'⟧ ⟹
F C (P ∥ Q) a x (P ∥ Q')"
and cResB: "⋀P P' a x y C. ⟦P ⟼a<νx> ≺ P'; y ≠ a; y ≠ x; y ♯ C;
⋀C. F C P a x P'⟧ ⟹ F C (<νy>P) a x (<νy>P')"
and cBang: "⋀P a x P' C. ⟦P ∥ !P ⟼a<νx> ≺ P'; ⋀C. F C (P ∥ !P) a x P'⟧ ⟹
F C (!P) a x P'"
shows "F C P a x P'"
proof -
from a ‹x ♯ P› show ?thesis
proof(nominal_induct x2 == "a<νx> ≺ P'" avoiding: C a x P' rule: transitions.strong_induct)
case(Tau P)
thus ?case by(simp add: residualInject)
next
case(Input P a x)
thus ?case by(simp add: residualInject)
next
case(Output P a b)
thus ?case by(simp add: residualInject)
next
case(Match P Rs b C a x)
thus ?case
by(force intro: cMatch simp add: residualInject)
next
case(Mismatch P Rs a b C c x)
thus ?case
by(force intro: cMismatch simp add: residualInject)
next
case(Sum1 P Q Rs C)
thus ?case by(force intro: cSum1)
next
case(Sum2 P Q Rs C)
thus ?case by(force intro: cSum2)
next
case(Open P a b P' C a' x P'')
have "b ♯ x" by fact hence bineqx: "b ≠ x" by simp
moreover have "a<νb> ≺ P' = a'<νx> ≺ P''" by fact
ultimately have aeqa': "a=a'" and P'eqP'': "P'' = [(b, x)] ∙ P'"
by(simp add: residualInject name_abs_eq)+
have "x ♯ <νb>P" by fact
with bineqx have "x ♯ P" by(simp add: name_fresh_abs)
have aineqb: "a ≠ b" by fact
have PTrans: "P ⟼a[b] ≺ P'" by fact
with ‹x ♯ P› have xineqa: "x ≠ a" by(force dest: freshFreeDerivative)
from PTrans have "([(b, x)] ∙ P) ⟼[(b, x)] ∙ (a[b] ≺ P')" by(rule transitions.eqvt)
with P'eqP'' xineqa aineqb have Trans: "([(b, x)] ∙ P) ⟼a[x] ≺ P''"
by(auto simp add: name_calc)
hence "F C (<νx>([(b, x)] ∙ P)) a x P''" using xineqa by(blast intro: cOpen)
with ‹x ♯ P› aeqa' show ?case by(simp add: alphaRes)
next
case(Par1B P a x P' Q C a' x' P'')
have "x ♯ x'" by fact hence xineqx': "x ≠ x'" by simp
moreover have Eq: "a«x» ≺ (P' ∥ Q) = a'<νx'> ≺ P''" by fact
hence aeqa': "a = BoundOutputS a'" by(simp add: residualInject)
have "x ♯ Q" by fact
have "x' ♯ P ∥ Q" by fact
hence "x' ♯ P" and "x' ♯ Q" by simp+
have P''eq: "P'' = ([(x, x')] ∙ P') ∥ Q"
proof -
from Eq xineqx' have "(P' ∥ Q) = [(x, x')] ∙ P''"
by(simp add: residualInject name_abs_eq)
hence "([(x, x')] ∙ (P' ∥ Q)) = P''" by simp
with ‹x' ♯ Q›‹x ♯ Q› show ?thesis by(simp add: name_fresh_fresh)
qed
have "x ♯ P''" by fact
with P''eq ‹x ≠ x'› have "x' ♯ P'" by(simp add: name_fresh_left name_calc)
have "P ⟼a«x» ≺ P'" by fact
with ‹x' ♯ P'› aeqa' have "P ⟼a'<νx'> ≺ ([(x, x')] ∙ P')"
by(simp add: alphaBoundResidual)
moreover have "⋀C. F C P a' x' ([(x, x')] ∙ P')"
proof -
fix C
have "⋀C a' x' P''. ⟦a«x» ≺ P' = a'<νx'> ≺ P''; x' ♯ P⟧ ⟹ F C P a' x' P''" by fact
moreover with aeqa' xineqx' ‹x' ♯ P'› have "a«x» ≺ P' = a'<νx'> ≺ ([(x, x')] ∙ P')"
by(simp add: residualInject name_abs_eq name_fresh_left name_calc)
ultimately show "F C P a' x' ([(x, x')] ∙ P')" using ‹x' ♯ P› aeqa' by blast
qed
ultimately have "F C (P ∥ Q) a' x' (([(x, x')] ∙ P') ∥ Q)" using ‹x' ♯ Q›aeqa'
by(blast intro: cPar1B)
with P''eq show ?case by simp
next
case(Par1F P P' Q α)
thus ?case by(simp add: residualInject)
next
case(Par2B Q a x Q' P C a' x' Q'')
have "x ♯ x'" by fact hence xineqx': "x ≠ x'" by simp
moreover have Eq: "a«x» ≺ (P ∥ Q') = a'<νx'> ≺ Q''" by fact
hence aeqa': "a = BoundOutputS a'" by(simp add: residualInject)
have "x ♯ P" by fact
have "x' ♯ P ∥ Q" by fact
hence "x' ♯ P" and "x' ♯ Q" by simp+
have Q''eq: "Q'' = P ∥ ([(x, x')] ∙ Q')"
proof -
from Eq xineqx' have "(P ∥ Q') = [(x, x')] ∙ Q''"
by(simp add: residualInject name_abs_eq)
hence "([(x, x')] ∙ (P ∥ Q')) = Q''" by simp
with ‹x' ♯ P› ‹x ♯ P› show ?thesis by(simp add: name_fresh_fresh)
qed
have "x ♯ Q''" by fact
with Q''eq ‹x ≠ x'› have "x' ♯ Q'" by(simp add: name_fresh_left name_calc)
have "Q ⟼a«x» ≺ Q'" by fact
with ‹x' ♯ Q'› aeqa' have "Q ⟼a'<νx'> ≺ ([(x, x')] ∙ Q')"
by(simp add: alphaBoundResidual)
moreover have "⋀C. F C Q a' x' ([(x, x')] ∙ Q')"
proof -
fix C
have "⋀C a' x' Q''. ⟦a«x» ≺ Q' = a'<νx'> ≺ Q''; x' ♯ Q⟧ ⟹ F C Q a' x' Q''" by fact
moreover with aeqa' xineqx' ‹x' ♯ Q'› have "a«x» ≺ Q' = a'<νx'> ≺ ([(x, x')] ∙ Q')"
by(simp add: residualInject name_abs_eq name_fresh_left name_calc)
ultimately show "F C Q a' x' ([(x, x')] ∙ Q')" using ‹x' ♯ Q›aeqa' by blast
qed
ultimately have "F C (P ∥ Q) a' x' (P ∥ ([(x, x')] ∙ Q'))" using ‹x' ♯ P›
by(blast intro: cPar2B)
with Q''eq show ?case by simp
next
case(Par2F P P' Q α)
thus ?case by(simp add: residualInject)
next
case(Comm1 P P' Q Q' a b x)
thus ?case by(simp add: residualInject)
next
case(Comm2 P P' Q Q' a b x)
thus ?case by(simp add: residualInject)
next
case(Close1 P P' Q Q' a x y)
thus ?case by(simp add: residualInject)
next
case(Close2 P P' Q Q' a x y)
thus ?case by(simp add: residualInject)
next
case(ResB P a x P' y C a' x' P'')
have "x ♯ x'" by fact hence xineqx': "x ≠ x'" by simp
moreover have Eq: "a«x» ≺ (<νy>P') = a'<νx'> ≺ P''" by fact
hence aeqa': "a = BoundOutputS a'" by(simp add: residualInject)
have "y ♯ x'" by fact hence yineqx': "y ≠ x'" by simp
moreover have "x' ♯ <νy>P" by fact
ultimately have "x' ♯ P" by(simp add: name_fresh_abs)
have "y ≠ x" and "y ♯ a" and yFreshC: "y ♯ C" by fact+
have P''eq: "P'' = <νy>([(x, x')] ∙ P')"
proof -
from Eq xineqx' have "<νy>P' = [(x, x')] ∙ P''"
by(simp add: residualInject name_abs_eq)
hence "([(x, x')] ∙ (<νy>P')) = P''" by simp
with yineqx' ‹y ≠ x› show ?thesis by(simp add: name_fresh_fresh)
qed
have "x ♯ P''" by fact
with P''eq ‹y ≠ x› ‹x ≠ x'› have "x' ♯ P'" by(simp add: name_fresh_left name_calc name_fresh_abs)
have "P ⟼a«x» ≺ P'" by fact
with ‹x' ♯ P'› aeqa' have "P ⟼a'<νx'> ≺ ([(x, x')] ∙ P')"
by(simp add: alphaBoundResidual)
moreover have "⋀C. F C P a' x' ([(x, x')] ∙ P')"
proof -
fix C
have "⋀C a' x' P''. ⟦a«x» ≺ P' = a'<νx'> ≺ P''; x' ♯ P⟧ ⟹ F C P a' x' P''" by fact
moreover with aeqa' xineqx' ‹x' ♯ P'› have "a«x» ≺ P' = a'<νx'> ≺ ([(x, x')] ∙ P')"
by(simp add: residualInject name_abs_eq name_fresh_left name_calc)
ultimately show "F C P a' x' ([(x, x')] ∙ P')" using ‹x' ♯ P› aeqa' by blast
qed
ultimately have "F C (<νy>P) a' x' (<νy>([(x, x')] ∙ P'))" using yineqx' ‹y ♯ a› yFreshC aeqa'
by(force intro: cResB)
with P''eq show ?case by simp
next
case(ResF P P' α y)
thus ?case by(simp add: residualInject)
next
case(Bang P Rs)
thus ?case by(force intro: cBang)
qed
qed
lemma tauInduct[consumes 1, case_names Tau Match Mismatch Sum1 Sum2 Par1 Par2 Comm1 Comm2 Close1 Close2 Res Bang]:
fixes P :: pi
and P' :: pi
and F :: "'a::fs_name ⇒ pi ⇒ pi ⇒ bool"
and C :: "'a::fs_name"
assumes Trans: "P ⟼τ ≺ P'"
and "⋀P C. F C (τ.(P)) P"
and "⋀P P' c C. ⟦P ⟼τ ≺ P'; ⋀C. F C P P'⟧ ⟹ F C ([c⌢c]P) P'"
and "⋀P P' c d C. ⟦P ⟼τ ≺ P'; ⋀C. F C P P'; c ≠ d⟧ ⟹ F C ([c≠d]P) P'"
and "⋀P P' Q C. ⟦P ⟼τ ≺ P'; ⋀C. F C P P'⟧ ⟹ F C (P ⊕ Q) P'"
and "⋀Q Q' P C. ⟦Q ⟼τ ≺ Q'; ⋀C. F C Q Q'⟧ ⟹ F C (P ⊕ Q) Q'"
and "⋀P P' Q C. ⟦P ⟼τ ≺ P'; ⋀C. F C P P'⟧ ⟹ F C (P ∥ Q) (P' ∥ Q)"
and "⋀Q Q' P C. ⟦Q ⟼τ ≺ Q'; ⋀C. F C Q Q'⟧ ⟹ F C (P ∥ Q) (P ∥ Q')"
and "⋀P a x P' Q b Q' C. ⟦P ⟼(BoundR (InputS a) x P'); Q ⟼OutputR a b ≺ Q'; x ♯ P; x ♯ Q; x ♯ C⟧ ⟹ F C (P ∥ Q) (P'[x::=b] ∥ Q')"
and "⋀P a b P' Q x Q' C. ⟦P ⟼OutputR a b ≺ P'; Q ⟼(BoundR (InputS a) x Q'); x ♯ P; x ♯ Q; x ♯ C⟧ ⟹ F C (P ∥ Q) (P' ∥ Q'[x::=b])"
and "⋀P a x P' Q y Q' C. ⟦P ⟼(BoundR (InputS a) x P'); Q ⟼a<νy> ≺ Q'; x ♯ P; x ♯ Q; x ♯ C; y ♯ P; y ♯ Q; y ♯ C; x ≠ y⟧ ⟹ F C (P ∥ Q) (<νy>(P'[x::=y] ∥ Q'))"
and "⋀P a y P' Q x Q' C. ⟦P ⟼a<νy> ≺ P'; Q ⟼(BoundR (InputS a) x Q'); x ♯ P; x ♯ Q; x ♯ C; y ♯ P; y ♯ Q; y ♯ C; x ≠ y⟧ ⟹ F C (P ∥ Q) (<νy>(P' ∥ Q'[x::=y]))"
and "⋀P P' x C. ⟦P ⟼τ ≺ P'; x ♯ C; ⋀C. F C P P'⟧ ⟹
F C (<νx>P) (<νx>P')"
and "⋀P P' C. ⟦P ∥ !P ⟼τ ≺ P'; ⋀C. F C (P ∥ !P) P'⟧ ⟹ F C (!P) P'"
shows "F C P P'"
proof -
from Trans show ?thesis
by(nominal_induct x2=="τ ≺ P'" avoiding: C arbitrary: P' rule: transitions.strong_induct,
auto simp add: residualInject intro: assms)
qed
inductive bangPred :: "pi ⇒ pi ⇒ bool"
where
aux1: "bangPred P (!P)"
| aux2: "bangPred P (P ∥ !P)"
inductive_cases nilCases'[simplified pi.distinct residual.distinct]: "𝟬 ⟼ Rs"
inductive_cases tauCases'[simplified pi.distinct residual.distinct]: "τ.(P) ⟼ Rs"
inductive_cases inputCases'[simplified pi.inject residualInject]: "a<b>.P ⟼ Rs"
inductive_cases outputCases'[simplified pi.inject residualInject]: "a{b}.P ⟼ Rs"
inductive_cases matchCases'[simplified pi.inject residualInject]: "[a⌢b]P ⟼ Rs"
inductive_cases mismatchCases'[simplified pi.inject residualInject]: "[a≠b]P ⟼ Rs"
inductive_cases sumCases'[simplified pi.inject residualInject]: "P ⊕ Q ⟼ Rs"
inductive_cases parCasesB'[simplified pi.distinct residual.distinct]: "P ∥ Q ⟼ b«y» ≺ P'"
inductive_cases parCasesF'[simplified pi.distinct residual.distinct]: "P ∥ Q ⟼ α ≺ P'"
inductive_cases resCases'[simplified pi.distinct residual.distinct]: "<νx>P ⟼ Rs"
inductive_cases resCasesB'[simplified pi.distinct residual.distinct]: "<νx'>P ⟼ a«y'» ≺ P'"
inductive_cases resCasesF'[simplified pi.distinct residual.distinct]: "<νx>P ⟼ α ≺ P'"
inductive_cases bangCases[simplified pi.distinct residual.distinct]: "!P ⟼ Rs"
lemma tauCases[consumes 1, case_names cTau]:
fixes P :: pi
and α :: freeRes
and P' :: pi
assumes "τ.(P) ⟼α ≺ P'"
and "⟦α = τ; P = P'⟧ ⟹ Prop (τ) P"
shows "Prop α P'"
using assms
by(erule_tac tauCases', auto simp add: pi.inject residualInject)
lemma outputCases[consumes 1, case_names cOutput]:
fixes a :: name
and b :: name
and P :: pi
and α :: freeRes
and P' :: pi
assumes "a{b}.P ⟼α ≺ P'"
and "⟦α = a[b]; P = P'⟧ ⟹ Prop (a[b]) P"
shows "Prop α P'"
using assms
by(erule_tac outputCases', auto simp add: residualInject)
lemma zeroTrans[dest]:
fixes Rs :: residual
assumes "𝟬 ⟼ Rs"
shows "False"
using assms
by(induct rule: nilCases', auto)
lemma resZeroTrans[dest]:
fixes x :: name
and Rs :: residual
assumes "<νx>𝟬 ⟼ Rs"
shows "False"
using assms
by(induct rule: resCases', auto simp add: pi.inject alpha')
lemma matchTrans[dest]:
fixes a :: name
and b :: name
and P :: pi
and Rs :: residual
assumes "[a⌢b]P ⟼ Rs"
and "a≠b"
shows "False"
using assms
by(induct rule: matchCases', auto)
lemma mismatchTrans[dest]:
fixes a :: name
and P :: pi
and Rs :: residual
assumes "[a≠a]P ⟼ Rs"
shows "False"
using assms
by(induct rule: mismatchCases', auto)
lemma inputCases[consumes 4, case_names cInput]:
fixes a :: name
and x :: name
and P :: pi
and P' :: pi
assumes Input: "a<x>.P ⟼ b«y» ≺ yP'"
and "y ≠ a"
and "y ≠ x"
and "y ♯ P"
and A: "⟦b = InputS a; yP' = ([(x, y)] ∙ P)⟧ ⟹ Prop (InputS a) y ([(x, y)] ∙ P)"
shows "Prop b y yP'"
proof -
note assms
moreover from Input ‹y ≠ a› ‹y ≠ x› ‹y ♯ P› have "y ♯ b"
by(force dest: freshBoundDerivative simp add: abs_fresh)
moreover obtain z::name where "z ≠ y" and "z ≠ x" and "z ♯ P" and "z ≠ a" and "z ♯ b" and "z ♯ yP'"
by(generate_fresh "name", auto simp add: fresh_prod)
moreover obtain z'::name where "z' ≠ y" and "z' ≠ x" and "z' ≠ z" and "z' ♯ P" and "z' ≠ a" and "z' ♯ b" and "z' ♯ yP'"
by(generate_fresh "name", auto simp add: fresh_prod)
ultimately show ?thesis
by(cases rule: transitions.strong_cases[where x=y and b=z and xa=z and xb=z and xc=z and xd=z and xe=z
and xf=z and xg=z and y=z' and ya=z' and yb=y and yc=z'])
(auto simp add: pi.inject residualInject alpha abs_fresh fresh_prod fresh_left calc_atm)+
qed
lemma tauBoundTrans[dest]:
fixes P :: pi
and a :: subject
and x :: name
and P' :: pi
assumes "τ.(P) ⟼a«x» ≺ P'"
shows False
using assms
by - (ind_cases "τ.(P) ⟼a«x» ≺ P'")
lemma tauOutputTrans[dest]:
fixes P :: pi
and a :: name
and b :: name
and P' :: pi
assumes "τ.(P) ⟼a[b] ≺ P'"
shows False
using assms
by - (ind_cases "τ.(P) ⟼a[b] ≺ P'", auto simp add: residualInject)
lemma inputFreeTrans[dest]:
fixes a :: name
and x :: name
and P :: pi
and α :: freeRes
and P' :: pi
assumes "a<x>.P ⟼α ≺ P'"
shows False
using assms
by - (ind_cases "a<x>.P ⟼α ≺ P'")
lemma inputBoundOutputTrans[dest]:
fixes a :: name
and x :: name
and P :: pi
and b :: name
and y :: name
and P' :: pi
assumes "a<x>.P ⟼b<νy> ≺ P'"
shows False
using assms
by - (ind_cases "a<x>.P ⟼b<νy> ≺ P'", auto simp add: residualInject)
lemma outputTauTrans[dest]:
fixes a :: name
and b :: name
and P :: pi
and P' :: pi
assumes "a{b}.P ⟼τ ≺ P'"
shows False
using assms
by - (ind_cases "a{b}.P ⟼τ ≺ P'", auto simp add: residualInject)
lemma outputBoundTrans[dest]:
fixes a :: name
and b :: name
and P :: pi
and c :: subject
and x :: name
and P' :: pi
assumes "a{b}.P ⟼c«x» ≺ P'"
shows False
using assms
by - (ind_cases "a{b}.P ⟼c«x» ≺ P'")
lemma outputIneqTrans[dest]:
fixes a :: name
and b :: name
and P :: pi
and c :: name
and d :: name
and P' :: pi
assumes "a{b}.P ⟼c[d] ≺ P'"
and "a ≠ c ∨ b ≠ d"
shows "False"
using assms
by - (ind_cases "a{b}.P ⟼c[d] ≺ P'", auto simp add: residualInject pi.inject alpha')
lemma outputFreshTrans[dest]:
fixes a :: name
and b :: name
and P :: pi
and α :: freeRes
and P' :: pi
assumes "a{b}.P ⟼α ≺ P'"
and "a ♯ α ∨ b ♯ α"
shows "False"
using assms
by - (ind_cases "a{b}.P ⟼α ≺ P'", auto simp add: residualInject pi.inject alpha')
lemma inputIneqTrans[dest]:
fixes a :: name
and x :: name
and P :: pi
and b :: subject
and y :: name
and P' :: pi
assumes "a<x>.P ⟼b«y» ≺ P'"
and "a ♯ b"
shows "False"
using assms
by - (ind_cases "a<x>.P ⟼b«y» ≺ P'", auto simp add: residualInject pi.inject)
lemma resTauBoundTrans[dest]:
fixes x :: name
and P :: pi
and a :: subject
and y :: name
and P' :: pi
assumes "<νx>τ.(P) ⟼a«y» ≺ P'"
shows False
using assms
by - (ind_cases "<νx>τ.(P) ⟼a«y» ≺ P'", auto simp add: residualInject pi.inject alpha')
lemma resTauOutputTrans[dest]:
fixes x :: name
and P :: pi
and a :: name
and b :: name
and P' :: pi
assumes "<νx>τ.(P) ⟼a[b] ≺ P'"
shows False
using assms
by - (ind_cases "<νx>τ.(P) ⟼a[b] ≺ P'", auto simp add: residualInject pi.inject alpha')
lemma resInputFreeTrans[dest]:
fixes x :: name
fixes a :: name
and y :: name
and P :: pi
and α :: freeRes
and P' :: pi
assumes "<νx>a<y>.P ⟼α ≺ P'"
shows False
using assms
by - (ind_cases "<νx>a<y>.P ⟼α ≺ P'", auto simp add: pi.inject residualInject alpha')
lemma resInputBoundOutputTrans[dest]:
fixes x :: name
and a :: name
and y :: name
and P :: pi
and b :: name
and z :: name
and P' :: pi
assumes "<νx>a<y>.P ⟼b<νz> ≺ P'"
shows False
using assms
by - (ind_cases "<νx>a<y>.P ⟼b<νz> ≺ P'", auto simp add: pi.inject residualInject alpha')
lemma resOutputTauTrans[dest]:
fixes x :: name
and a :: name
and b :: name
and P :: pi
and P' :: pi
assumes "<νx>a{b}.P ⟼τ ≺ P'"
shows False
using assms
by - (ind_cases "<νx>a{b}.P ⟼τ ≺ P'", auto simp add: residualInject pi.inject alpha')
lemma resOutputInputTrans[dest]:
fixes x :: name
and a :: name
and b :: name
and P :: pi
and c :: name
and y :: name
and P' :: pi
assumes "<νx>a{b}.P ⟼c<y> ≺ P'"
shows False
using assms
by - (ind_cases "<νx>a{b}.P ⟼c<y> ≺ P'", auto simp add: pi.inject residualInject alpha')
lemma resOutputOutputTrans[dest]:
fixes x :: name
and a :: name
and P :: pi
and b :: name
and y :: name
and P' :: pi
assumes "<νx>a{x}.P ⟼b[y] ≺ P'"
shows False
using assms
by - (ind_cases "<νx>a{x}.P ⟼b[y] ≺ P'", auto simp add: pi.inject residualInject alpha' calc_atm)
lemma resTrans[dest]:
fixes x :: name
and b :: name
and Rs :: residual
and y :: name
shows "<νx>x{b}.P ⟼ Rs ⟹ False"
and "<νx>x<y>.P ⟼ Rs ⟹ False"
apply(ind_cases "<νx>x{b}.P ⟼ Rs", auto simp add: pi.inject alpha' calc_atm)
by(ind_cases "<νx>x<y>.P ⟼ Rs", auto simp add: pi.inject alpha' calc_atm abs_fresh fresh_left)
lemma matchCases[consumes 1, case_names cMatch]:
fixes a :: name
and b :: name
and P :: pi
and Rs :: residual
and F :: "name ⇒ name ⇒ bool"
assumes "[a⌢b]P ⟼ Rs"
and "⟦P ⟼ Rs; a = b⟧ ⟹ F a a"
shows "F a b"
using assms
by(induct rule: matchCases', auto)
lemma mismatchCases[consumes 1, case_names cMismatch]:
fixes a :: name
and b :: name
and P :: pi
and Rs :: residual
and F :: "name ⇒ name ⇒ bool"
assumes Trans: "[a≠b]P ⟼ Rs"
and cMatch: "⟦P ⟼ Rs; a ≠ b⟧ ⟹ F a b"
shows "F a b"
using assms
by(induct rule: mismatchCases', auto)
lemma sumCases[consumes 1, case_names cSum1 cSum2]:
fixes P :: pi
and Q :: pi
and Rs :: residual
assumes Trans: "P ⊕ Q ⟼ Rs"
and cSum1: "P ⟼ Rs ⟹ Prop"
and cSum2: "Q ⟼ Rs ⟹ Prop"
shows Prop
using assms
by(induct rule: sumCases', auto)
lemma name_abs_alpha:
fixes a :: name
and b :: name
and P :: pi
assumes "b ♯ P"
shows "[a].P = [b].([(a, b)] ∙ P)"
proof(cases "a=b", auto)
assume "a ≠ b"
with assms show ?thesis
by(force intro: abs_fun_eq3[OF pt_name_inst, OF at_name_inst]
simp add: name_swap name_calc name_fresh_left)
qed
lemma parCasesB[consumes 3, case_names cPar1 cPar2]:
fixes P :: pi
and Q :: pi
and a :: subject
and x :: name
and PQ' :: pi
and C :: "'a::fs_name"
assumes "P ∥ Q ⟼ a«x» ≺ PQ'"
and "x ♯ P"
and "x ♯ Q"
and "⋀P'. P ⟼ a«x» ≺ P' ⟹ Prop (P' ∥ Q)"
and "⋀Q'. Q ⟼ a«x» ≺ Q' ⟹ Prop (P ∥ Q')"
shows "Prop PQ'"
proof -
note assms
moreover from ‹P ∥ Q ⟼a«x» ≺ PQ'› ‹x ♯ P› ‹x ♯ Q› have "x ♯ a"
by(force dest: freshBoundDerivative)
moreover obtain y::name where "y ≠ x" and "y ♯ P" and "y ♯ Q" and "y ♯ a" and "y ♯ PQ'"
by(generate_fresh "name", auto simp add: fresh_prod)
moreover obtain z::name where "z ≠ y" and "z ≠ x" and "z ♯ P" and "z ♯ Q" and "z ♯ a" and "z ♯ PQ'"
by(generate_fresh "name", auto simp add: fresh_prod)
ultimately show ?thesis
by(cases rule: transitions.strong_cases[where x=y and b=y and xa=x and xb=x and xc=y and xd=y and xe=y
and xf=y and xg=y and y=z and ya = z and yb=z and yc=z])
(auto simp add: pi.inject residualInject alpha abs_fresh fresh_prod)+
qed
lemma parCasesF[consumes 1, case_names cPar1 cPar2 cComm1 cComm2 cClose1 cClose2]:
fixes P :: pi
and Q :: pi
and α :: freeRes
and P' :: pi
and C :: "'a::fs_name"
and F :: "freeRes ⇒ pi ⇒ bool"
assumes Trans: "P ∥ Q ⟼ α ≺ PQ'"
and icPar1F: "⋀P'. ⟦P ⟼ α ≺ P'⟧ ⟹ F α (P' ∥ Q)"
and icPar2F: "⋀Q'. ⟦Q ⟼ α ≺ Q'⟧ ⟹ F α (P ∥ Q')"
and icComm1: "⋀P' Q' a b x. ⟦P ⟼ a<x> ≺ P'; Q ⟼ a[b] ≺ Q'; x ♯ P; x♯ Q; x ≠ a; x ≠ b; x ♯ Q'; x ♯ C; α = τ⟧ ⟹ F (τ) (P'[x::=b] ∥ Q')"
and icComm2: "⋀P' Q' a b x. ⟦P ⟼ a[b] ≺ P'; Q ⟼ a<x> ≺ Q'; x ♯ P; x ♯ Q; x ≠ a; x ≠ b; x ♯ P'; x ♯ C; α = τ⟧ ⟹ F (τ) (P' ∥ Q'[x::=b])"
and icClose1: "⋀P' Q' a x y. ⟦P ⟼ a<x> ≺ P'; Q ⟼ a<νy> ≺ Q'; x ♯ P; x ♯ Q; x ≠ a; x ≠ y; x ♯ Q'; y ♯ P; y ♯ Q; y ≠ a; y ♯ P'; x ♯ C; y ♯ C; α = τ⟧ ⟹
F (τ) (<νy>(P'[x::=y] ∥ Q'))"
and icClose2: "⋀P' Q' a x y. ⟦P ⟼ a<νy> ≺ P'; Q ⟼ a<x> ≺ Q'; x ♯ P; x ♯ Q; x ≠ a; x ≠ y; x ♯ P'; y ♯ P; y ♯ Q; y ≠ a; y ♯ Q'; x ♯ C; y ♯ C; α = τ⟧ ⟹
F (τ) (<νy>(P' ∥ Q'[x::=y]))"
shows "F α PQ'"
proof -
note assms
moreover obtain x::name where "x ♯ P" and "x ♯ Q" and "x ♯ α" and "x ♯ PQ'" and "x ♯ C"
by(generate_fresh "name", auto simp add: fresh_prod)
moreover obtain y::name where "y ♯ P" and "y ♯ Q" and "y ♯ α" and "y ♯ PQ'" and "y ♯ C" and "x ≠ y"
by(generate_fresh "name", auto simp add: fresh_prod)
ultimately show ?thesis
by(cases rule: transitions.strong_cases[where x=x and b=x and xa=x and xb=x and xc=x and xd=x and xe=x
and xf=x and xg=x and y=y and ya=y and yb=y and yc=y])
(auto simp add: pi.inject residualInject alpha abs_fresh fresh_prod)+
qed
lemma resCasesF[consumes 1, case_names cRes]:
fixes x :: name
and P :: pi
and α :: freeRes
and P' :: pi
and C :: "'a::fs_name"
assumes "<νx>P ⟼ α ≺ xP'"
and "⋀P'. ⟦P ⟼ α ≺ P'; x ♯ α⟧ ⟹ F (<νx>P')"
shows "F xP'"
proof -
note assms
moreover from ‹<νx>P ⟼α ≺ xP'› have "x ♯ α" and "x ♯ xP'"
by(force dest: freshFreeDerivative simp add: abs_fresh)+
moreover obtain y::name where "y ≠ x" and "y ♯ P" and "y ♯ α" and "y ♯ xP'"
by(generate_fresh "name", auto simp add: fresh_prod)
moreover obtain z::name where "z ≠ y" and "z ≠ x" and "z ♯ P" and "z ♯ α" and "z ♯ xP'"
by(generate_fresh "name", auto simp add: fresh_prod)
ultimately show ?thesis
by(cases rule: transitions.strong_cases[where x=y and b=y and xa=y and xb=y and xc=y and xd=y and xe=y
and xf=y and xg=y and y=z and ya=z and yb=z and yc=x])
(auto simp add: pi.inject residualInject alpha abs_fresh fresh_prod)+
qed
lemma resCasesB[consumes 3, case_names cOpen cRes]:
fixes x :: name
and P :: pi
and a :: subject
and y :: name
and yP' :: pi
and C :: "'a::fs_name"
assumes Trans: "<νy>P ⟼a«x» ≺ yP'"
and xineqy: "x ≠ y"
and xineqy: "x ♯ P"
and rcOpen: "⋀b P'. ⟦P ⟼b[y] ≺ P'; b ≠ y; a = BoundOutputS b⟧ ⟹ F (BoundOutputS b) ([(x, y)] ∙ P')"
and rcResB: "⋀P'. ⟦P ⟼ a«x» ≺ P'; y ♯ a⟧ ⟹ F a (<νy>P')"
shows "F a yP'"
proof -
note assms
moreover from ‹<νy>P ⟼a«x» ≺ yP'› ‹x ≠ y› have "y ♯ a" and "y ♯ yP'"
by(force dest: freshBoundDerivative simp add: abs_fresh)+
moreover from ‹<νy>P ⟼a«x» ≺ yP'› ‹x ♯ P› have "x ♯ a"
by(force dest: freshBoundDerivative simp add: abs_fresh)+
moreover obtain z::name where "z ≠ y" and "z ≠ x" and "z ♯ P" and "z ♯ a" and "z ♯ yP'"
by(generate_fresh "name", auto simp add: fresh_prod)
moreover obtain z'::name where "z' ≠ y" and "z' ≠ x" and "z' ≠ z" and "z' ♯ P" and "z' ♯ a" and "z' ♯ yP'"
by(generate_fresh "name", auto simp add: fresh_prod)
ultimately show ?thesis
by(cases rule: transitions.strong_cases[where x=z and b=y and xa=z and xb=z and xc=z and xd=z and xe=z
and xf=z and xg=x and y=z' and ya=z' and yb=y and yc=z'])
(auto simp add: pi.inject residualInject alpha abs_fresh fresh_prod fresh_left calc_atm)+
qed
lemma bangInduct[consumes 1, case_names cPar1B cPar1F cPar2B cPar2F cComm1 cComm2 cClose1 cClose2 cBang]:
fixes F :: "'a::fs_name ⇒ pi ⇒ residual ⇒ bool"
and P :: pi
and Rs :: residual
and C :: "'a::fs_name"
assumes Trans: "!P ⟼ Rs"
and cPar1B: "⋀a x P' C. ⟦P ⟼ a«x» ≺ P'; x ♯ P; x ♯ C⟧ ⟹ F C (P ∥ !P) (a«x» ≺ P' ∥ !P)"
and cPar1F: "⋀α P' C. ⟦P ⟼ α ≺ P'⟧ ⟹ F C (P ∥ !P) (α ≺ P' ∥ !P)"
and cPar2B: "⋀a x P' C. ⟦!P ⟼ a«x» ≺ P'; x ♯ P; x ♯ C; ⋀C. F C (!P) (a«x» ≺ P')⟧ ⟹
F C (P ∥ !P) (a«x» ≺ P ∥ P')"
and cPar2F: "⋀α P' C. ⟦!P ⟼ α ≺ P'; ⋀C. F C (!P) (α ≺ P')⟧ ⟹ F C (P ∥ !P) (α ≺ P ∥ P')"
and cComm1: "⋀a x P' b P'' C. ⟦P ⟼ a<x> ≺ P'; !P ⟼ (OutputR a b) ≺ P''; x ♯ C;
⋀C. F C (!P) ((OutputR a b) ≺ P'')⟧ ⟹
F C (P ∥ !P) (τ ≺ (P'[x::=b]) ∥ P'')"
and cComm2: "⋀a b P' x P'' C. ⟦P ⟼ (OutputR a b) ≺ P'; !P ⟼ a<x> ≺ P''; x ♯ C;
⋀C. F C (!P) (a<x> ≺ P'')⟧ ⟹
F C (P ∥ !P) (τ ≺ P' ∥ (P''[x::=b]))"
and cClose1: "⋀a x P' y P'' C. ⟦P ⟼ a<x> ≺ P'; !P ⟼ a<νy> ≺ P''; y ♯ P; x ♯ C; y ♯ C;
⋀C. F C (!P) (a<νy> ≺ P'')⟧ ⟹
F C (P ∥ !P) (τ ≺ <νy>((P'[x::=y]) ∥ P''))"
and cClose2: "⋀a y P' x P'' C. ⟦P ⟼ a<νy> ≺ P'; !P ⟼ a<x> ≺ P''; y ♯ P; x ♯ C; y ♯ C;
⋀C. F C (!P) (a<x> ≺ P'')⟧ ⟹
F C (P ∥ !P) (τ ≺ <νy>(P' ∥ (P''[x::=y])))"
and cBang: "⋀Rs C. ⟦P ∥ !P ⟼ Rs; ⋀C. F C (P ∥ !P) Rs⟧ ⟹ F C (!P) Rs"
shows "F C (!P) Rs"
proof -
have "⋀X Y C. ⟦X ⟼ Y; bangPred P X⟧ ⟹ F C X Y"
proof -
fix X Y C
assume "X ⟼ Y" and "bangPred P X"
thus "F C X Y"
proof(nominal_induct avoiding: C rule: transitions.strong_induct)
case(Tau Pa)
thus ?case
apply -
by(ind_cases "bangPred P (τ.(Pa))")
next
case(Input x a Pa)
thus ?case
apply -
by(ind_cases "bangPred P (a<x>.Pa)")
next
case(Output a b Pa)
thus ?case
apply -
by(ind_cases "bangPred P (a{b}.Pa)")
next
case(Match Pa Rs b)
thus ?case
apply -
by(ind_cases "bangPred P ([b⌢b]Pa)")
next
case(Mismatch Pa Rs a b)
thus ?case
apply -
by(ind_cases "bangPred P ([a≠b]Pa)")
next
case(Open Pa a b Pa')
thus ?case
apply -
by(ind_cases "bangPred P (<νb>Pa)")
next
case(Sum1 Pa Rs Q)
thus ?case
apply -
by(ind_cases "bangPred P (Pa ⊕ Q)")
next
case(Sum2 Q Rs Pa)
thus ?case
apply -
by(ind_cases "bangPred P (Pa ⊕ Q)")
next
case(Par1B Pa a x Pa' Q )
thus ?case
apply -
by(ind_cases "bangPred P (Pa ∥ Q)", auto intro: cPar1B simp add: pi.inject)
next
case(Par1F Pa α Pa' Q)
thus ?case
apply -
by(ind_cases "bangPred P (Pa ∥ Q)", auto intro: cPar1F simp add: pi.inject)
next
case(Par2B Qa a x Qa' Pa)
thus ?case
apply -
by(ind_cases "bangPred P (Pa ∥ Qa)", auto intro: cPar2B aux1 simp add: pi.inject)
next
case(Par2F Qa α Qa' Pa)
thus ?case
apply -
by(ind_cases "bangPred P (Pa ∥ Qa)", auto intro: cPar2F aux1 simp add: pi.inject)
next
case(Comm1 Pa a x Pa' Q b Q')
thus ?case
apply -
by(ind_cases "bangPred P (Pa ∥ Q)", auto intro: cComm1 aux1 simp add: pi.inject)
next
case(Comm2 Pa a b Pa' Q x Q')
thus ?case
apply -
by(ind_cases "bangPred P (Pa ∥ Q)", auto intro: cComm2 aux1 simp add: pi.inject)
next
case(Close1 Pa a x Pa' Q y Q')
thus ?case
apply -
by(ind_cases "bangPred P (Pa ∥ Q)", auto intro: cClose1 aux1 simp add: pi.inject)
next
case(Close2 Pa a y Pa' Q x Q')
thus ?case
apply -
by(ind_cases "bangPred P (Pa ∥ Q)", auto intro: cClose2 aux1 simp add: pi.inject)
next
case(ResB Pa a x P' y)
thus ?case
apply -
by(ind_cases "bangPred P (<νy>Pa)")
next
case(ResF Pa α P' y)
thus ?case
apply -
by(ind_cases "bangPred P (<νy>Pa)")
next
case(Bang Pa Rs)
thus ?case
apply -
by(ind_cases "bangPred P (!Pa)", auto intro: cBang aux2 simp add: pi.inject)
qed
qed
with Trans show ?thesis by(force intro: bangPred.aux1)
qed
end
Theory Late_Semantics1
theory Late_Semantics1
imports Late_Semantics
begin
free_constructors case_subject for
InputS
| BoundOutputS
by(auto simp add: subject.inject)
(metis Rep_subject_inverse subject.constr_rep(1,2) subject_Rep.exhaust)
free_constructors case_freeRes for
OutputR
| TauR
by(auto simp add: freeRes.inject)
(metis Abs_freeRes_cases Abs_freeRes_inverse freeRes.constr_rep(1,2) freeRes_Rep.exhaust)
end
Theory Rel
theory Rel
imports Agent
begin
definition eqvt :: "(('a::pt_name) × ('a::pt_name)) set ⇒ bool"
where "eqvt Rel ≡ (∀x (perm::name prm). x ∈ Rel ⟶ perm ∙ x ∈ Rel)"
lemma eqvtRelI:
fixes Rel :: "('a::pt_name × 'a) set"
and P :: 'a
and Q :: 'a
and perm :: "name prm"
assumes "eqvt Rel"
and "(P, Q) ∈ Rel"
shows "(perm ∙ P, perm ∙ Q) ∈ Rel"
using assms
by(auto simp add: eqvt_def)
lemma eqvtRelE:
fixes Rel :: "('a::pt_name × 'a) set"
and P :: 'a
and Q :: 'a
and perm :: "name prm"
assumes "eqvt Rel"
and "(perm ∙ P, perm ∙ Q) ∈ Rel"
shows "(P, Q) ∈ Rel"
proof -
have "rev perm ∙ (perm ∙ P) = P" and "rev perm ∙ (perm ∙ Q) = Q"
by(simp add: pt_rev_pi[OF pt_name_inst, OF at_name_inst])+
with assms show ?thesis
by(force dest: eqvtRelI[of _ _ _ "rev perm"])
qed
lemma eqvtTrans[intro]:
fixes Rel :: "('a::pt_name × 'a) set"
and Rel' :: "('a × 'a) set"
assumes EqvtRel: "eqvt Rel"
and EqvtRel': "eqvt Rel'"
shows "eqvt (Rel O Rel')"
using assms
by(force simp add: eqvt_def)
lemma eqvtUnion[intro]:
fixes Rel :: "('a::pt_name × 'a) set"
and Rel' :: "('a × 'a) set"
assumes EqvtRel: "eqvt Rel"
and EqvtRel': "eqvt Rel'"
shows "eqvt (Rel ∪ Rel')"
using assms
by(force simp add: eqvt_def)
definition substClosed :: "(pi × pi) set ⇒ (pi × pi) set" where
"substClosed Rel ≡ {(P, Q) | P Q. ∀σ. (P[<σ>], Q[<σ>]) ∈ Rel}"
lemma eqvtSubstClosed:
fixes Rel :: "(pi × pi) set"
assumes eqvtRel: "eqvt Rel"
shows "eqvt (substClosed Rel)"
proof(simp add: eqvt_def substClosed_def, auto)
fix P Q perm s
assume "∀s. (P[<s>], Q[<s>]) ∈ Rel"
hence "(P[<(rev (perm::name prm) ∙ s)>], Q[<(rev perm ∙ s)>]) ∈ Rel" by simp
with eqvtRel have "(perm ∙ (P[<(rev perm ∙ s)>]), perm ∙ (Q[<(rev perm ∙ s)>])) ∈ Rel"
by(rule eqvtRelI)
thus "((perm ∙ P)[<s>], (perm ∙ Q)[<s>]) ∈ Rel"
by(simp add: name_per_rev)
qed
lemma substClosedSubset:
fixes Rel :: "(pi × pi) set"
shows "substClosed Rel ⊆ Rel"
proof(auto simp add: substClosed_def)
fix P Q
assume "∀s. (P[<s>], Q[<s>]) ∈ Rel"
hence "(P[<[]>], Q[<[]>]) ∈ Rel" by blast
thus "(P, Q) ∈ Rel" by simp
qed
lemma partUnfold:
fixes P :: pi
and Q :: pi
and σ :: "(name × name) list"
and Rel :: "(pi × pi) set"
assumes "(P, Q) ∈ substClosed Rel"
shows "(P[<σ>], Q[<σ>]) ∈ substClosed Rel"
using assms
proof(auto simp add: substClosed_def)
fix σ'
assume "∀σ. (P[<σ>], Q[<σ>]) ∈ Rel"
hence "(P[<(σ@σ')>], Q[<(σ@σ')>]) ∈ Rel" by blast
thus "((P[<σ>])[<σ'>], (Q[<σ>])[<σ'>]) ∈ Rel"
by simp
qed
inductive_set bangRel :: "(pi × pi) set ⇒ (pi × pi) set"
for Rel :: "(pi × pi) set"
where
BRBang: "(P, Q) ∈ Rel ⟹ (!P, !Q) ∈ bangRel Rel"
| BRPar: "(R, T) ∈ Rel ⟹ (P, Q) ∈ (bangRel Rel) ⟹ (R ∥ P, T ∥ Q) ∈ (bangRel Rel)"
| BRRes: "(P, Q) ∈ bangRel Rel ⟹ (<νa>P, <νa>Q) ∈ bangRel Rel"
inductive_cases BRBangCases': "(P, !Q) ∈ bangRel Rel"
inductive_cases BRParCases': "(P, Q ∥ !Q) ∈ bangRel Rel"
inductive_cases BRResCases': "(P, <νx>Q) ∈ bangRel Rel"
lemma eqvtBangRel:
fixes Rel :: "(pi × pi) set"
assumes eqvtRel: "eqvt Rel"
shows "eqvt(bangRel Rel)"
proof(simp add: eqvt_def, auto)
fix P Q perm
assume "(P, Q) ∈ bangRel Rel"
thus "((perm::name prm) ∙ P, perm ∙ Q) ∈ bangRel Rel"
proof(induct)
fix P Q
assume "(P, Q) ∈ Rel"
with eqvtRel have "(perm ∙ P, perm ∙ Q) ∈ Rel"
by(rule eqvtRelI)
thus "(perm ∙ !P, perm ∙ !Q) ∈ bangRel Rel"
by(force intro: BRBang)
next
fix P Q R T
assume R: "(R, T) ∈ Rel"
assume BR: "(perm ∙ P, perm ∙ Q) ∈ bangRel Rel"
from eqvtRel R have "(perm ∙ R, perm ∙ T) ∈ Rel"
by(rule eqvtRelI)
with BR show "(perm ∙ (R ∥ P), perm ∙ (T ∥ Q)) ∈ bangRel Rel"
by(force intro: BRPar)
next
fix P Q a
assume "(perm ∙ P, perm ∙ Q) ∈ bangRel Rel"
thus "(perm ∙ <νa>P, perm ∙ <νa>Q) ∈ bangRel Rel"
by(force intro: BRRes)
qed
qed
lemma BRBangCases[consumes 1, case_names BRBang]:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and F :: "pi ⇒ bool"
assumes "(P, !Q) ∈ bangRel Rel"
and "⋀P. (P, Q) ∈ Rel ⟹ F (!P)"
shows "F P"
using assms
by(induct rule: BRBangCases', auto simp add: pi.inject)
lemma BRParCases[consumes 1, case_names BRPar]:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and F :: "pi ⇒ bool"
assumes "(P, Q ∥ !Q) ∈ bangRel Rel"
and "⋀P R. ⟦(P, Q) ∈ Rel; (R, !Q) ∈ bangRel Rel⟧ ⟹ F (P ∥ R)"
shows "F P"
using assms
by(induct rule: BRParCases', auto simp add: pi.inject)
lemma bangRelSubset:
fixes Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes "(P, Q) ∈ bangRel Rel"
and "⋀P Q. (P, Q) ∈ Rel ⟹ (P, Q) ∈ Rel'"
shows "(P, Q) ∈ bangRel Rel'"
using assms
by(induct rule: bangRel.induct) (auto intro: BRBang BRPar BRRes)
lemma bangRelSymetric:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
assumes A: "(P, Q) ∈ bangRel Rel"
and Sym: "⋀P Q. (P, Q) ∈ Rel ⟹ (Q, P) ∈ Rel"
shows "(Q, P) ∈ bangRel Rel"
proof -
from A show ?thesis
proof(induct)
fix P Q
assume "(P, Q) ∈ Rel"
hence "(Q, P) ∈ Rel" by(rule Sym)
thus "(!Q, !P) ∈ bangRel Rel" by(rule BRBang)
next
fix P Q R T
assume RRelT: "(R, T) ∈ Rel"
assume IH: "(Q, P) ∈ bangRel Rel"
from RRelT have "(T, R) ∈ Rel" by(rule Sym)
thus "(T ∥ Q, R ∥ P) ∈ bangRel Rel" using IH by(rule BRPar)
next
fix P Q a
assume "(Q, P) ∈ bangRel Rel"
thus "(<νa>Q, <νa>P) ∈ bangRel Rel" by(rule BRRes)
qed
qed
primrec resChain :: "name list ⇒ pi ⇒ pi" where
base: "resChain [] P = P"
| step: "resChain (x#xs) P = <νx>(resChain xs P)"
lemma resChainPerm[simp]:
fixes perm :: "name prm"
and lst :: "name list"
and P :: pi
shows "perm ∙ (resChain lst P) = resChain (perm ∙ lst) (perm ∙ P)"
by(induct_tac lst, auto)
lemma resChainFresh:
fixes a :: name
and lst :: "name list"
and P :: pi
assumes "a ♯ (lst, P)"
shows "a ♯ (resChain lst P)"
using assms apply(induct_tac lst)
apply(simp add: fresh_prod)
by(simp add: fresh_prod name_fresh_abs)
end
Theory Strong_Late_Sim
theory Strong_Late_Sim
imports Late_Semantics1 Rel
begin
definition derivative :: "pi ⇒ pi ⇒ subject ⇒ name ⇒ (pi × pi) set ⇒ bool" where
"derivative P Q a x Rel ≡ case a of InputS b ⇒ (∀u. (P[x::=u], Q[x::=u]) ∈ Rel)
| BoundOutputS b ⇒ (P, Q) ∈ Rel"
definition simulation :: "pi ⇒ (pi × pi) set ⇒ pi ⇒ bool" ("_ ↝[_] _" [80, 80, 80] 80) where
"P ↝[Rel] Q ≡ (∀a x Q'. Q ⟼a«x» ≺ Q' ∧ x ♯ P ⟶ (∃P'. P ⟼a«x» ≺ P' ∧ derivative P' Q' a x Rel)) ∧
(∀α Q'. Q ⟼α ≺ Q' ⟶ (∃P'. P ⟼α ≺ P' ∧ (P', Q') ∈ Rel))"
lemma monotonic:
fixes A :: "(pi × pi) set"
and B :: "(pi × pi) set"
and P :: pi
and P' :: pi
assumes "P ↝[A] P'"
and "A ⊆ B"
shows "P ↝[B] P'"
using assms
apply(auto simp add: simulation_def derivative_def)
by(case_tac a) fastforce+
lemma derivativeMonotonic:
fixes A :: "(pi × pi) set"
and B :: "(pi × pi) set"
and P :: pi
and Q :: pi
and a :: subject
and x :: name
assumes "derivative P Q a x A"
and "A ⊆ B"
shows "derivative P Q a x B"
using assms
by(case_tac a, auto simp add: derivative_def)
lemma derivativeEqvtI:
fixes P :: pi
and Q :: pi
and a :: subject
and x :: name
and Rel :: "(pi × pi) set"
and perm :: "name prm"
assumes Der: "derivative P Q a x Rel"
and Eqvt: "eqvt Rel"
shows "derivative (perm ∙ P) (perm ∙ Q) (perm ∙ a) (perm ∙ x) Rel"
using assms
apply(case_tac a, auto simp add: derivative_def)
apply(erule_tac x="rev perm ∙ u" in allE)
apply(drule_tac perm=perm in eqvtRelI)
apply(blast)
apply(force simp add: eqvt_subs name_per_rev)
by(force simp add: eqvt_def)
lemma derivativeEqvtI2:
fixes P :: pi
and Q :: pi
and a :: subject
and x :: name
and Rel :: "(pi × pi) set"
and perm :: "name prm"
assumes Der: "derivative P Q a x Rel"
and Eqvt: "eqvt Rel"
shows "derivative (perm ∙ P) (perm ∙ Q) a (perm ∙ x) Rel"
using assms
apply(case_tac a, auto simp add: derivative_def)
apply(erule_tac x="rev perm ∙ u" in allE)
apply(drule_tac perm=perm in eqvtRelI)
apply(blast)
apply(force simp add: eqvt_subs name_per_rev)
by(force simp add: eqvt_def)
lemma freshUnit[simp]:
fixes y :: name
shows "y ♯ ()"
by(auto simp add: fresh_def supp_unit)
lemma simCasesCont[consumes 1, case_names Bound Free]:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and C :: "'a::fs_name"
assumes Eqvt: "eqvt Rel"
and Bound: "⋀a x Q'. ⟦Q ⟼ a«x» ≺ Q'; x ♯ P; x ♯ Q; x ♯ a; x ♯ C⟧ ⟹ ∃P'. P ⟼ a«x» ≺ P' ∧ derivative P' Q' a x Rel"
and Free: "⋀α Q'. Q ⟼ α ≺ Q' ⟹ ∃P'. P ⟼ α ≺ P' ∧ (P', Q') ∈ Rel"
shows "P ↝[Rel] Q"
using Free
proof(auto simp add: simulation_def)
fix a x Q'
assume "(x::name) ♯ P"
assume Trans: "Q ⟼ a«x» ≺ Q'"
obtain y::name where "y ♯ P" and "y ♯ Q" and "y ♯ a" and "y ♯ C" and "y ♯ Q'" and "y ≠ x"
by(generate_fresh "name") auto
from Trans ‹y ♯ Q'› have "Q ⟼ a«y» ≺ [(x, y)] ∙ Q'" by(simp add: alphaBoundResidual)
hence "∃P'. P ⟼ a«y» ≺ P' ∧ derivative P' ([(x, y)] ∙ Q') a y Rel"
using ‹y ♯ P› ‹y ♯ Q› ‹y ♯ a› ‹y ♯ C›
by(rule Bound)
then obtain P' where PTrans: "P ⟼ a«y» ≺ P'" and PDer: "derivative P' ([(x, y)] ∙ Q') a y Rel"
by blast
from PTrans ‹x ♯ P› ‹y ≠ x› have "x ♯ P'" by(force intro: freshBoundDerivative)
with PTrans have "P ⟼ a«x» ≺ [(x, y)] ∙ P'" by(simp add: alphaBoundResidual name_swap)
moreover have "derivative ([(x, y)] ∙ P') Q' a x Rel"
proof -
from PDer Eqvt have "derivative ([(x, y)] ∙ P') ([(x, y)] ∙ [(x, y)] ∙ Q') a ([(x, y)] ∙ y) Rel"
by(rule derivativeEqvtI2)
with ‹y ≠ x› show ?thesis by(simp add: name_calc)
qed
ultimately show "∃P'. P ⟼a«x» ≺ P' ∧ derivative P' Q' a x Rel" by blast
qed
lemma simCases[case_names Bound Free]:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
assumes Bound: "⋀a y Q'. ⟦Q ⟼ a«y» ≺ Q'; y ♯ P⟧ ⟹ ∃P'. P ⟼ a«y» ≺ P' ∧ derivative P' Q' a y Rel"
and Free: "⋀α Q'. Q ⟼ α ≺ Q' ⟹ ∃P'. P ⟼ α ≺ P' ∧ (P', Q') ∈ Rel"
shows "P ↝[Rel] Q"
using assms
by(auto simp add: simulation_def)
lemma resSimCases[consumes 1, case_names BoundOutput BoundR FreeR]:
fixes x :: name
and P :: pi
and Rel :: "(pi × pi) set"
and Q :: pi
and C :: "'a::fs_name"
assumes Eqvt: "eqvt Rel"
and BoundO: "⋀Q' a. ⟦Q ⟼a[x] ≺ Q'; a ≠ x⟧ ⟹ ∃P'. P ⟼a<νx> ≺ P' ∧ (P', Q') ∈ Rel"
and BR: "⋀Q' a y. ⟦Q ⟼a«y» ≺ Q'; x ♯ a; x ≠ y; y ♯ C⟧ ⟹ ∃P'. P ⟼a«y» ≺ P' ∧ derivative P' (<νx>Q') a y Rel"
and BF: "⋀Q' α. ⟦Q ⟼α ≺ Q'; x ♯ α⟧ ⟹ ∃P'. P ⟼α ≺ P' ∧ (P', <νx>Q') ∈ Rel"
shows "P ↝[Rel] <νx>Q"
using Eqvt
proof(induct rule: simCasesCont[where C="(C, x, Q)"])
case(Bound a y Q')
have "y ♯ (C, x, Q)" by fact
hence yFreshC: "y ♯ C" and yineqx: "y ≠ x" and "y ♯ Q"
by(simp add: fresh_prod)+
have "<νx>Q ⟼a«y» ≺ Q'" by fact
thus ?case using yineqx ‹y ♯ Q›
proof(induct rule: resCasesB)
case(cOpen a' Q')
have "Q ⟼a'[x] ≺ Q'" and "a' ≠ x" by fact+
then obtain P' where PTrans: "P ⟼a'<νx> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel" by(force dest: BoundO)
from PTrans ‹y ♯ P› yineqx have "y ♯ P'" by(force dest: freshBoundDerivative)
with PTrans have "P ⟼a'<νy> ≺ ([(x, y)] ∙ P')" by(simp add: alphaBoundResidual)
moreover from P'RelQ' Eqvt have "([(x, y)] ∙ P', [(x, y)] ∙ Q') ∈ Rel" by(auto simp add: eqvt_def)
ultimately show ?case by(force simp add: derivative_def name_swap)
next
case(cRes Q')
have "Q ⟼a«y» ≺ Q'" and "x ♯ a" by fact+
with yineqx yFreshC show ?case by(force dest: BR)
qed
next
case(Free α Q')
have "<νx>Q ⟼α ≺ Q'" by fact
thus ?case
proof(induct rule: resCasesF)
case(cRes Q')
have "Q ⟼α ≺ Q'" and "x ♯ α" by fact+
thus ?case by(rule BF)
qed
qed
lemma simE:
fixes P :: pi
and Rel :: "(pi × pi) set"
and Q :: pi
and a :: subject
and x :: name
and Q' :: pi
assumes "P ↝[Rel] Q"
shows "Q ⟼ a«x» ≺ Q' ⟹ x ♯ P ⟹ ∃P'. P ⟼ a«x» ≺ P' ∧ (derivative P' Q' a x Rel)"
and "Q ⟼ α ≺ Q' ⟹ ∃P'. P ⟼ α ≺ P' ∧ (P', Q') ∈ Rel"
using assms by(simp add: simulation_def)+
lemma eqvtI:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and perm :: "name prm"
assumes Sim: "P ↝[Rel] Q"
and RelRel': "Rel ⊆ Rel'"
and EqvtRel': "eqvt Rel'"
shows "(perm ∙ P) ↝[Rel'] (perm ∙ Q)"
proof(induct rule: simCases)
case(Bound a y Q')
have QTrans: "(perm ∙ Q) ⟼ a«y» ≺ Q'" and yFreshP: "y ♯ perm ∙ P" by fact+
from QTrans have "(rev perm ∙ (perm ∙ Q)) ⟼ rev perm ∙ (a«y» ≺ Q')"
by(rule transitions.eqvt)
hence "Q ⟼ (rev perm ∙ a)«(rev perm ∙ y)» ≺ (rev perm ∙ Q')"
by(simp add: name_rev_per)
moreover from yFreshP have "(rev perm ∙ y) ♯ P" by(simp add: name_fresh_left)
ultimately have "∃P'. P ⟼ (rev perm ∙ a)«rev perm ∙ y» ≺ P' ∧ derivative P' (rev perm ∙ Q') (rev perm ∙ a) (rev perm ∙ y) Rel" using Sim
by(force intro: simE)
then obtain P' where PTrans: "P ⟼ (rev perm ∙ a)«rev perm ∙ y» ≺ P'" and Pderivative: "derivative P' (rev perm ∙ Q') (rev perm ∙ a) (rev perm ∙ y) Rel" by blast
from PTrans have "(perm ∙ P) ⟼ perm ∙ ((rev perm ∙ a)«rev perm ∙ y» ≺ P')" by(rule transitions.eqvt)
hence L1: "(perm ∙ P) ⟼ a«y» ≺ (perm ∙ P')" by(simp add: name_per_rev)
from Pderivative RelRel' have "derivative P' (rev perm ∙ Q') (rev perm ∙ a) (rev perm ∙ y) Rel'"
by(rule derivativeMonotonic)
hence "derivative (perm ∙ P') (perm ∙ (rev perm ∙ Q')) (perm ∙ (rev perm ∙ a)) (perm ∙ (rev perm ∙ y)) Rel'" using EqvtRel'
by(rule derivativeEqvtI)
hence "derivative (perm ∙ P') Q' a y Rel'" by(simp add: name_per_rev)
with L1 show ?case by blast
next
case(Free α Q')
have "(perm ∙ Q) ⟼ α ≺ Q'" by fact
hence "(rev perm ∙ (perm ∙ Q)) ⟼ rev perm ∙ (α ≺ Q')"
by(rule transitions.eqvt)
hence "Q ⟼ (rev perm ∙ α) ≺ (rev perm ∙ Q')"
by(simp add: name_rev_per)
with Sim have "∃P'. P ⟼ (rev perm ∙ α) ≺ P' ∧ (P', (rev perm ∙ Q')) ∈ Rel"
by(force intro: simE)
then obtain P' where PTrans: "P ⟼ (rev perm ∙ α) ≺ P'" and PRel: "(P', (rev perm ∙ Q')) ∈ Rel"
by blast
from PTrans have "(perm ∙ P) ⟼ perm ∙ ((rev perm ∙ α)≺ P')" by(rule transitions.eqvt)
hence L1: "(perm ∙ P) ⟼ α ≺ (perm ∙ P')" by(simp add: name_per_rev)
from PRel EqvtRel' RelRel' have "((perm ∙ P'), (perm ∙ (rev perm ∙ Q'))) ∈ Rel'"
by(force intro: eqvtRelI)
hence "((perm ∙ P'), Q') ∈ Rel'" by(simp add: name_per_rev)
with L1 show "∃P'. (perm ∙ P) ⟼α ≺ P' ∧ (P', Q') ∈ Rel'" by blast
qed
lemma derivativeReflexive:
fixes P :: pi
and a :: subject
and x :: name
and Rel :: "(pi × pi) set"
assumes "Id ⊆ Rel"
shows "derivative P P a x Rel"
using assms
apply(cases a)
by(auto simp add: derivative_def)
lemma reflexive:
fixes P :: pi
and Rel :: "(pi × pi) set"
assumes "Id ⊆ Rel"
shows "P ↝[Rel] P"
using assms
by(auto simp add: simulation_def derivativeReflexive)
lemma transitive:
fixes P :: pi
and Q :: pi
and R :: pi
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
and Rel'' :: "(pi × pi) set"
assumes PSimQ: "P ↝[Rel] Q"
and QSimR: "Q ↝[Rel'] R"
and Eqvt': "eqvt Rel''"
and Trans: "Rel O Rel' ⊆ Rel''"
shows "P ↝[Rel''] R"
using Eqvt'
proof(induct rule: simCasesCont[where C=Q])
case(Bound a x R')
have RTrans: "R ⟼ a«x» ≺ R'" by fact
from ‹x ♯ Q› QSimR RTrans obtain Q' where QTrans: "Q ⟼ a«x» ≺ Q'"
and QDer: "derivative Q' R' a x Rel'"
by(blast dest: simE)
with QTrans ‹x ♯ P› PSimQ obtain P' where PTrans: "P ⟼ a«x» ≺ P'"
and PDer: "derivative P' Q' a x Rel"
by(blast dest: simE)
moreover from PDer QDer Trans have "derivative P' R' a x Rel''"
by(cases a) (auto simp add: derivative_def)
ultimately show ?case by blast
next
case(Free α R')
have RTrans: "R ⟼ α ≺ R'" by fact
with QSimR obtain Q' where QTrans: "Q ⟼ α ≺ Q'"
and Q'RelR': "(Q', R') ∈ Rel'"
by(blast dest: simE)
from QTrans PSimQ obtain P' where PTrans: "P ⟼ α ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from P'RelQ' Q'RelR' Trans have "(P', R') ∈ Rel''" by blast
with PTrans show ?case by blast
qed
end
Theory Strong_Late_Bisim
theory Strong_Late_Bisim
imports Strong_Late_Sim
begin
lemma monoAux: "A ⊆ B ⟹ P ↝[A] Q ⟶ P ↝[B] Q"
by(auto intro: Strong_Late_Sim.monotonic)
coinductive_set bisim :: "(pi × pi) set"
where
step: "⟦P ↝[bisim] Q; (Q, P) ∈ bisim⟧ ⟹ (P, Q) ∈ bisim"
monos monoAux
abbreviation
strongBisimJudge (infixr "∼" 65) where "P ∼ Q ≡ (P, Q) ∈ bisim"
lemma monotonic': "mono(λS. {(P, Q) |P Q. P ↝[S] Q ∧ Q ↝[S] P})"
apply(rule monoI)
by(auto dest: monoAux)
lemma monotonic: "mono(λp x1 x2.
∃P Q. x1 = P ∧
x2 = Q ∧ P ↝[{(xa, x). p xa x}] Q ∧ Q ↝[{(xa, x). p xa x}] P)"
apply(rule monoI)
by(auto intro: Strong_Late_Sim.monotonic)
lemma bisimCoinduct[case_names cSim cSym , consumes 1]:
assumes p: "(P, Q) ∈ X"
and rSim: "⋀R S. (R, S) ∈ X ⟹ R ↝[(X ∪ bisim)] S"
and rSym: "⋀R S. (R, S) ∈ X ⟹ (S, R) ∈ X"
shows "P ∼ Q"
proof -
have aux: "X ∪ bisim = {(P, Q). (P, Q) ∈ X ∨ P ∼ Q}" by blast
from p show ?thesis
apply(coinduct, auto)
apply(fastforce dest: rSim simp add: aux)
by(fastforce dest: rSym)
qed
lemma bisimE:
fixes P :: pi
and Q :: pi
assumes "P ∼ Q"
shows "P ↝[bisim] Q"
using assms
by(auto intro: bisim.cases)
lemma bisimI:
fixes P :: pi
and Q :: pi
assumes "P ↝[bisim] Q"
and "Q ∼ P"
shows "P ∼ Q"
using assms
by(rule bisim.intros)
definition old_bisim :: "(pi × pi) set ⇒ bool" where
"old_bisim Rel ≡ ∀(P, Q) ∈ Rel. P ↝[Rel] Q ∧ (Q, P) ∈ Rel"
lemma oldBisimBisimEq:
shows "(⋃{Rel. (old_bisim Rel)}) = bisim" (is "?LHS = ?RHS")
proof
show "?LHS ⊆ ?RHS"
proof auto
fix P Q Rel
assume "(P, Q) ∈ Rel" and "old_bisim Rel"
thus "P ∼ Q"
proof(coinduct rule: bisimCoinduct)
case(cSim P Q)
with ‹old_bisim Rel› show ?case
by(fastforce simp add: old_bisim_def intro: Strong_Late_Sim.monotonic)
next
case(cSym P Q)
with ‹old_bisim Rel› show ?case
by(auto simp add: old_bisim_def)
qed
qed
next
show "?RHS ⊆ ?LHS"
proof auto
fix P Q
assume "P ∼ Q"
moreover hence "old_bisim bisim"
by(auto simp add: old_bisim_def dest: bisim.cases)
ultimately show "∃Rel. old_bisim Rel ∧ (P, Q) ∈ Rel"
by blast
qed
qed
lemma reflexive:
fixes P :: pi
shows "P ∼ P"
proof -
have "(P, P) ∈ Id" by simp
thus ?thesis
by(coinduct rule: bisimCoinduct, auto intro: Strong_Late_Sim.reflexive)
qed
lemma symmetric:
fixes P :: pi
and Q :: pi
assumes "P ∼ Q"
shows "Q ∼ P"
using assms
by(auto dest: bisim.cases)
lemma bisimClosed:
fixes P :: pi
and Q :: pi
and p :: "name prm"
assumes "P ∼ Q"
shows "(p ∙ P) ∼ (p ∙ Q)"
proof -
let ?X = "{(p ∙ P, p ∙ Q) | P Q (p::name prm). P ∼ Q}"
from ‹P ∼ Q› have "(p ∙ P, p ∙ Q) ∈ ?X" by blast
thus ?thesis
proof(coinduct rule: bisimCoinduct)
case(cSim pP pQ)
from ‹(pP, pQ) ∈ ?X› obtain P Q p where "P ∼ Q" and "pP = (p::name prm) ∙ P" and "pQ = p ∙ Q"
by auto
from ‹P ∼ Q› have "P ↝[bisim] Q" by(rule bisimE)
moreover have "bisim ⊆ ?X"
proof
fix x
assume "x ∈ bisim"
moreover have "x = (([]::name prm) ∙ x)" by auto
ultimately show "x ∈ ?X"
apply(case_tac x)
by(clarify, simp only: eqvts) metis
qed
moreover have "eqvt ?X"
proof(auto simp add: eqvt_def)
fix P Q
fix perm1::"name prm"
fix perm2::"name prm"
assume "P ∼ Q"
moreover have "perm1 ∙ perm2 ∙ P = (perm1 @ perm2) ∙ P" by(simp add: pt2[OF pt_name_inst])
moreover have "perm1 ∙ perm2 ∙ Q = (perm1 @ perm2) ∙ Q" by(simp add: pt2[OF pt_name_inst])
ultimately show "∃P' Q'. (∃(perm::name prm). perm1 ∙ perm2 ∙ P = perm ∙ P' ∧
perm1 ∙ perm2 ∙ Q = perm ∙ Q') ∧ P' ∼ Q'"
by blast
qed
ultimately have "(p ∙ P) ↝[?X] (p ∙ Q)"
by(rule Strong_Late_Sim.eqvtI)
with ‹pP = p ∙ P› ‹pQ = p ∙ Q› show ?case
by(force intro: Strong_Late_Sim.monotonic)
next
case(cSym P Q)
thus ?case by(auto intro: symmetric)
qed
qed
lemma bisimEqvt[simp]:
shows "eqvt bisim"
by(auto simp add: eqvt_def bisimClosed)
lemma transitive:
fixes P :: pi
and Q :: pi
and R :: pi
assumes "P ∼ Q"
and "Q ∼ R"
shows "P ∼ R"
proof -
let ?X = "bisim O bisim"
from assms have "(P, R) ∈ ?X" by blast
thus ?thesis
proof(coinduct rule: bisimCoinduct)
case(cSim P R)
thus ?case
by(fastforce intro: Strong_Late_Sim.transitive dest: bisimE simp add: eqvtTrans)
next
case(cSym P R)
thus ?case
by(auto dest: symmetric)
qed
qed
lemma bisimTransitiveCoinduct[case_names cSim cSym, case_conclusion bisim step, consumes 2]:
assumes "(P, Q) ∈ X"
and "eqvt X"
and rSim: "⋀R S. (R, S) ∈ X ⟹ R ↝[(bisim O (X ∪ bisim) O bisim)] S"
and rSym: "⋀R S. (R, S) ∈ X ⟹ (S, R) ∈ bisim O (X ∪ bisim) O bisim"
shows "P ∼ Q"
proof -
let ?X = "bisim O (X ∪ bisim) O bisim"
from ‹(P, Q) ∈ X› have "(P, Q) ∈ ?X" by(auto intro: reflexive)
thus ?thesis
proof(coinduct rule: bisimCoinduct)
case(cSim P Q)
{
fix P P' Q' Q
assume "P ∼ P'" and "(P', Q') ∈ X ∪ bisim" and "Q' ∼ Q"
have "P ↝[(?X ∪ bisim)] Q"
proof(cases "(P', Q') ∈ X")
case True
from ‹P ∼ P'› have "P ↝[bisim] P'" by(rule bisimE)
moreover from ‹(P', Q') ∈ X› have "P' ↝[(?X)] Q'" by(rule rSim)
moreover from ‹eqvt X› bisimEqvt have "eqvt(?X ∪ bisim)" by blast
moreover have "bisim O ?X ⊆ ?X ∪ bisim" by(auto dest: transitive)
ultimately have "P ↝[(?X ∪ bisim)] Q'" by(rule Strong_Late_Sim.transitive)
moreover from ‹Q' ∼ Q› have "Q' ↝[bisim] Q" by(rule bisimE)
moreover note ‹eqvt(?X ∪ bisim)›
moreover have "(?X ∪ bisim) O bisim ⊆ ?X ∪ bisim"
by auto (blast dest: transitive)+
ultimately show ?thesis by(rule Strong_Late_Sim.transitive)
next
case False
from ‹(P', Q') ∉ X› ‹(P', Q') ∈ X ∪ bisim› have "P' ∼ Q'" by simp
with ‹P ∼ P'› ‹Q' ∼ Q› have "P ∼ Q" by(blast dest: transitive)
hence "P ↝[bisim] Q" by(rule bisimE)
moreover have "bisim ⊆ ?X ∪ bisim" by auto
ultimately show ?thesis by(rule Strong_Late_Sim.monotonic)
qed
}
with ‹(P, Q) ∈ ?X› show ?case by auto
case(cSym P Q)
{
fix P P' Q' Q
assume "P ∼ P'" and "(P', Q') ∈ X ∪ bisim" and "Q' ∼ Q"
have "(Q, P) ∈ bisim O (X ∪ bisim) O bisim"
proof(cases "(P', Q') ∈ X")
case True
from ‹(P', Q') ∈ X› have "(Q', P') ∈ ?X" by(rule rSym)
then obtain Q'' P'' where "Q' ∼ Q''" and "(Q'', P'') ∈ X ∪ bisim" and "P'' ∼ P'"
by auto
from ‹Q' ∼ Q› ‹Q' ∼ Q''› have "Q ∼ Q''" by(metis transitive symmetric)
moreover from ‹P ∼ P'› ‹P'' ∼ P'› have "P'' ∼ P" by(metis transitive symmetric)
ultimately show ?thesis using ‹(Q'', P'') ∈ X ∪ bisim› by blast
next
case False
from ‹(P', Q') ∉ X› ‹(P', Q') ∈ X ∪ bisim› have "P' ∼ Q'" by simp
with ‹P ∼ P'› ‹Q' ∼ Q› have "Q ∼ P" by(metis transitive symmetric)
thus ?thesis by(blast intro: reflexive)
qed
}
with ‹(P, Q) ∈ ?X› show ?case by blast
qed
qed
end
Theory Strong_Late_Bisim_Subst
theory Strong_Late_Bisim_Subst
imports Strong_Late_Bisim
begin
abbreviation
StrongEqJudge (infixr "∼⇧s" 65) where "P ∼⇧s Q ≡ (P, Q) ∈ (substClosed bisim)"
lemma congBisim:
fixes P :: pi
and Q :: pi
assumes "P ∼⇧s Q"
shows "P ∼ Q"
using assms substClosedSubset by blast
lemma eqvt:
shows "eqvt (substClosed bisim)"
by(rule eqvtSubstClosed[OF Strong_Late_Bisim.bisimEqvt])
lemma eqClosed:
fixes P :: pi
and Q :: pi
and perm :: "name prm"
assumes "P ∼⇧s Q"
shows "(perm ∙ P) ∼⇧s (perm ∙ Q)"
using assms
by(rule eqvtRelI[OF eqvt])
lemma reflexive:
fixes P :: pi
shows "P ∼⇧s P"
by(force simp add: substClosed_def intro: Strong_Late_Bisim.reflexive)
lemma symmetric:
fixes P :: pi
and Q :: pi
assumes "P ∼⇧s Q"
shows "Q ∼⇧s P"
using assms
by(force simp add: substClosed_def intro: Strong_Late_Bisim.symmetric)
lemma transitive:
fixes P :: pi
and Q :: pi
and R :: pi
assumes "P ∼⇧s Q"
and "Q ∼⇧s R"
shows "P ∼⇧s R"
using assms
by(force simp add: substClosed_def intro: Strong_Late_Bisim.transitive)
end
Theory Strong_Late_Sim_Pres
theory Strong_Late_Sim_Pres
imports Strong_Late_Sim
begin
lemma tauPres:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes PRelQ: "(P, Q) ∈ Rel"
shows "τ.(P) ↝[Rel] τ.(Q)"
proof -
show "τ.(P) ↝[Rel] τ.(Q)"
proof(induct rule: simCases)
case(Bound a x Q')
have "τ.(Q) ⟼ a«x» ≺ Q'" by fact
hence False by auto
thus ?case by simp
next
case(Free α Q')
have "τ.(Q) ⟼ α ≺ Q'" by fact
thus ?case
proof(induct rule: tauCases)
case cTau
have "τ.(P) ⟼ τ ≺ P" by(rule Late_Semantics.Tau)
with PRelQ show ?case by blast
qed
qed
qed
lemma inputPres:
fixes P :: pi
and x :: name
and Q :: pi
and a :: name
and Rel :: "(pi × pi) set"
assumes PRelQ: "∀y. (P[x::=y], Q[x::=y]) ∈ Rel"
and Eqvt: "eqvt Rel"
shows "a<x>.P ↝[Rel] a<x>.Q"
using Eqvt
proof(induct rule: simCasesCont[where C="(x, a, P, Q)"])
case(Bound b y Q')
from ‹y ♯ (x, a, P, Q)› have "y ≠ x" "y ≠ a" "y ♯ P" "y ♯ Q" by simp+
from ‹a<x>.Q ⟼b«y» ≺ Q'› ‹y ≠ a› ‹y ≠ x› ‹y ♯ Q› show ?case
proof(induct rule: inputCases)
case cInput
have "a<x>.P ⟼ a<x> ≺ P" by(rule Input)
hence "a<x>.P ⟼ a<y> ≺ ([(x, y)] ∙ P)" using ‹y ♯ P›
by(simp add: alphaBoundResidual)
moreover have "derivative ([(x, y)] ∙ P) ([(x, y)] ∙ Q) (InputS a) y Rel"
proof(auto simp add: derivative_def)
fix u
show "(([(x, y)] ∙ P)[y::=u], ([(x, y)] ∙ Q)[y::=u]) ∈ Rel"
proof(cases "y=u")
assume "y = u"
moreover have "([(y, x)] ∙ P, [(y, x)] ∙ Q) ∈ Rel"
proof -
from PRelQ have "(P[x::=x], Q[x::=x]) ∈ Rel" by blast
hence "(P, Q) ∈ Rel" by simp
with Eqvt show ?thesis by(rule eqvtRelI)
qed
ultimately show ?thesis by simp
next
assume yinequ: "y ≠ u"
show ?thesis
proof(cases "x = u")
assume "x = u"
moreover have "(([(y, x)] ∙ P)[y::=x], ([(y, x)] ∙ Q)[y::=x]) ∈ Rel"
proof -
from PRelQ have "(P[x::=y], Q[x::=y]) ∈ Rel" by blast
with Eqvt have "([(y, x)] ∙ (P[x::=y]), [(y, x)] ∙ (Q[x::=y])) ∈ Rel"
by(rule eqvtRelI)
with ‹y ≠ x› show ?thesis
by(simp add: eqvt_subs name_calc)
qed
ultimately show ?thesis by simp
next
assume xinequ: "x ≠ u"
hence "(([(y, x)] ∙ P)[y::=u], ([(y, x)] ∙ Q)[y::=u]) ∈ Rel"
proof -
from PRelQ have "(P[x::=u], Q[x::=u]) ∈ Rel" by blast
with Eqvt have "([(y, x)] ∙ (P[x::=u]), [(y, x)] ∙ (Q[x::=u])) ∈ Rel"
by(rule eqvtRelI)
with ‹y ≠ x› xinequ yinequ show ?thesis
by(simp add: eqvt_subs name_calc)
qed
thus ?thesis by simp
qed
qed
qed
ultimately show ?case by blast
qed
next
case(Free α Q')
have "a<x>.Q ⟼ α ≺ Q'" by fact
hence False by auto
thus ?case by blast
qed
lemma outputPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes PRelQ: "(P, Q) ∈ Rel"
shows "a{b}.P ↝[Rel] a{b}.Q"
proof -
show ?thesis
proof(induct rule: simCases)
case(Bound c x Q')
have "a{b}.Q ⟼ c«x» ≺ Q'" by fact
hence False by auto
thus ?case by simp
next
case(Free α Q')
have "a{b}.Q ⟼ α ≺ Q'" by fact
thus ?case
proof(induct rule: outputCases)
case cOutput
have "a{b}.P ⟼ a[b] ≺ P" by(rule Late_Semantics.Output)
with PRelQ show ?case by blast
qed
qed
qed
lemma matchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes PSimQ: "P ↝[Rel] Q"
and "Rel ⊆ Rel'"
shows "[a⌢b]P ↝[Rel'] [a⌢b]Q"
proof -
show ?thesis
proof(induct rule: simCases)
case(Bound c x Q')
have "x ♯ [a⌢b]P" by fact
hence xFreshP: "x ♯ P" by simp
have "[a⌢b]Q ⟼ c«x» ≺ Q'" by fact
thus ?case
proof(induct rule: matchCases)
case cMatch
have "Q ⟼c«x» ≺ Q'" by fact
with PSimQ xFreshP obtain P' where PTrans: "P ⟼c«x» ≺ P'"
and Pderivative: "derivative P' Q' c x Rel"
by(blast dest: simE)
from PTrans have "[a⌢a]P ⟼ c«x» ≺ P'" by(rule Late_Semantics.Match)
moreover from Pderivative ‹Rel ⊆ Rel'› have "derivative P' Q' c x Rel'"
by(cases c) (auto simp add: derivative_def)
ultimately show ?case by blast
qed
next
case(Free α Q')
have "[a⌢b]Q ⟼α ≺ Q'" by fact
thus ?case
proof(induct rule: matchCases)
case cMatch
have "Q ⟼ α ≺ Q'" by fact
with PSimQ obtain P' where PTrans: "P ⟼ α ≺ P'"
and PRel: "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans have "[a⌢a]P ⟼α ≺ P'" by(rule Late_Semantics.Match)
with PRel ‹Rel ⊆ Rel'› show ?case by blast
qed
qed
qed
lemma mismatchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes PSimQ: "P ↝[Rel] Q"
and "Rel ⊆ Rel'"
shows "[a≠b]P ↝[Rel'] [a≠b]Q"
proof(induct rule: simCases)
case(Bound c x Q')
have "x ♯ [a≠b]P" by fact
hence xFreshP: "x ♯ P" by simp
from ‹[a≠b]Q ⟼ c«x» ≺ Q'› show ?case
proof(induct rule: mismatchCases)
case cMismatch
have "Q ⟼c«x» ≺ Q'" by fact
with PSimQ xFreshP obtain P' where PTrans: "P ⟼c«x» ≺ P'"
and Pderivative: "derivative P' Q' c x Rel"
by(blast dest: simE)
from PTrans ‹a ≠ b› have "[a≠b]P ⟼ c«x» ≺ P'" by(rule Late_Semantics.Mismatch)
moreover from Pderivative ‹Rel ⊆ Rel'› have "derivative P' Q' c x Rel'"
by(cases c) (auto simp add: derivative_def)
ultimately show ?case by blast
qed
next
case(Free α Q')
have "[a≠b]Q ⟼α ≺ Q'" by fact
thus ?case
proof(induct rule: mismatchCases)
case cMismatch
have "Q ⟼ α ≺ Q'" by fact
with PSimQ obtain P' where PTrans: "P ⟼ α ≺ P'"
and PRel: "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans ‹a ≠ b› have "[a≠b]P ⟼α ≺ P'" by(rule Late_Semantics.Mismatch)
with PRel ‹Rel ⊆ Rel'› show ?case by blast
qed
qed
lemma sumPres:
fixes P :: pi
and Q :: pi
and R :: pi
assumes PSimQ: "P ↝[Rel] Q"
and "Id ⊆ Rel'"
and "Rel ⊆ Rel'"
shows "P ⊕ R ↝[Rel'] Q ⊕ R"
proof -
show ?thesis
proof(induct rule: simCases)
case(Bound a x QR)
have "x ♯ P ⊕ R" by fact
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by simp+
have "Q ⊕ R ⟼a«x» ≺ QR" by fact
thus ?case
proof(induct rule: sumCases)
case cSum1
have "Q ⟼a«x» ≺ QR" by fact
with xFreshP PSimQ obtain P' where PTrans: "P ⟼a«x» ≺ P'"
and Pderivative: "derivative P' QR a x Rel"
by(blast dest: simE)
from PTrans have "P ⊕ R ⟼a«x» ≺ P'" by(rule Late_Semantics.Sum1)
moreover from Pderivative ‹Rel ⊆ Rel'› have "derivative P' QR a x Rel'"
by(cases a) (auto simp add: derivative_def)
ultimately show ?case by blast
next
case cSum2
from ‹R ⟼a«x» ≺ QR› have "P ⊕ R ⟼a«x» ≺ QR" by(rule Sum2)
thus ?case using ‹Id ⊆ Rel'› by(blast intro: derivativeReflexive)
qed
next
case(Free α QR)
have "Q ⊕ R ⟼α ≺ QR" by fact
thus ?case
proof(induct rule: sumCases)
case cSum1
have "Q ⟼α ≺ QR" by fact
with PSimQ obtain P' where PTrans: "P ⟼α ≺ P'" and PRel: "(P', QR) ∈ Rel"
by(blast dest: simE)
from PTrans have "P ⊕ R ⟼α ≺ P'" by(rule Late_Semantics.Sum1)
with PRel ‹Rel ⊆ Rel'› show ?case by blast
next
case cSum2
from ‹R ⟼α ≺ QR› have "P ⊕ R ⟼α ≺ QR" by(rule Sum2)
thus ?case using ‹Id ⊆ Rel'› by(blast intro: derivativeReflexive)
qed
qed
qed
lemma parCompose:
fixes P :: pi
and Q :: pi
and R :: pi
and T :: pi
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
and Rel'' :: "(pi × pi) set"
assumes PSimQ: "P ↝[Rel] Q"
and RSimT: "R ↝[Rel'] T"
and PRelQ: "(P, Q) ∈ Rel"
and RRel'T: "(R, T) ∈ Rel'"
and Par: "⋀P Q R T. ⟦(P, Q) ∈ Rel; (R, T) ∈ Rel'⟧ ⟹ (P ∥ R, Q ∥ T) ∈ Rel''"
and Res: "⋀P Q a. (P, Q) ∈ Rel'' ⟹ (<νa>P, <νa>Q) ∈ Rel''"
and EqvtRel: "eqvt Rel"
and EqvtRel': "eqvt Rel'"
and EqvtRel'': "eqvt Rel''"
shows "P ∥ R ↝[Rel''] Q ∥ T"
using EqvtRel''
proof(induct rule: simCasesCont[where C="()"])
case(Bound a x Q')
have "x ♯ P ∥ R" and "x ♯ Q ∥ T" by fact+
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" and "x ♯ Q" and "x ♯ T" by simp+
have QTTrans: "Q ∥ T ⟼ a«x» ≺ Q'" by fact
thus ?case using ‹x ♯ Q› ‹x ♯ T›
proof(induct rule: parCasesB)
case(cPar1 Q')
have QTrans: "Q ⟼ a«x» ≺ Q'" and xFreshT: "x ♯ T" by fact+
from xFreshP PSimQ QTrans obtain P' where PTrans:"P ⟼ a«x» ≺ P'"
and Pderivative: "derivative P' Q' a x Rel"
by(blast dest: simE)
from PTrans xFreshR have "P ∥ R ⟼ a«x» ≺ P' ∥ R" by(rule Late_Semantics.Par1B)
moreover from Pderivative xFreshR xFreshT RRel'T have "derivative (P' ∥ R) (Q' ∥ T) a x Rel''"
by(cases a, auto intro: Par simp add: derivative_def forget)
ultimately show ?case by blast
next
case(cPar2 T')
have TTrans: "T ⟼ a«x» ≺ T'" and xFreshQ: "x ♯ Q" by fact+
from xFreshR RSimT TTrans obtain R' where RTrans:"R ⟼ a«x» ≺ R'"
and Rderivative: "derivative R' T' a x Rel'"
by(blast dest: simE)
from RTrans xFreshP have ParTrans: "P ∥ R ⟼ a«x» ≺ P ∥ R'" by(rule Late_Semantics.Par2B)
moreover from Rderivative xFreshP xFreshQ PRelQ have "derivative (P ∥ R') (Q ∥ T') a x Rel''"
by(cases a, auto intro: Par simp add: derivative_def forget)
ultimately show ?case by blast
qed
next
case(Free α QT')
have QTTrans: "Q ∥ T ⟼ α ≺ QT'" by fact
thus ?case using PSimQ RSimT PRelQ RRel'T
proof(induct rule: parCasesF[where C="(P, R)"])
case(cPar1 Q')
have RRel'T: "(R, T) ∈ Rel'" by fact
have "P ↝[Rel] Q" and "Q ⟼ α ≺ Q'" by fact+
then obtain P' where PTrans: "P ⟼ α ≺ P'" and PRel: "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans have Trans: "P ∥ R ⟼ α ≺ P' ∥ R" by(rule Late_Semantics.Par1F)
moreover from PRel RRel'T have "(P' ∥ R, Q' ∥ T) ∈ Rel''" by(blast intro: Par)
ultimately show ?case by blast
next
case(cPar2 T')
have PRelQ: "(P, Q) ∈ Rel" by fact
have "R ↝[Rel'] T" and "T ⟼ α ≺ T'" by fact+
then obtain R' where RTrans: "R ⟼ α ≺ R'" and RRel: "(R', T') ∈ Rel'"
by(blast dest: simE)
from RTrans have Trans: "P ∥ R ⟼ α ≺ P ∥ R'" by(rule Late_Semantics.Par2F)
moreover from PRelQ RRel have "(P ∥ R', Q ∥ T') ∈ Rel''" by(blast intro: Par)
ultimately show ?case by blast
next
case(cComm1 Q' T' a b x)
from ‹x ♯ (P, R)› have "x ♯ P" by simp
with ‹P ↝[Rel] Q› ‹Q ⟼ a<x> ≺ Q'› ‹x ♯ P›
obtain P' where PTrans: "P ⟼a<x> ≺ P'"
and Pderivative: "derivative P' Q' (InputS a) x Rel"
by(blast dest: simE)
from Pderivative have PRel: "(P'[x::=b], Q'[x::=b]) ∈ Rel" by(simp add: derivative_def)
have "R ↝[Rel'] T" and "T ⟼ a[b] ≺ T'" by fact+
then obtain R' where RTrans: "R ⟼a[b] ≺ R'" and RRel: "(R', T') ∈ Rel'"
by(blast dest: simE)
from PTrans RTrans have "P ∥ R ⟼ τ ≺ P'[x::=b] ∥ R'" by(rule Late_Semantics.Comm1)
moreover from PRel RRel have "(P'[x::=b] ∥ R', Q'[x::=b] ∥ T') ∈ Rel''" by(blast intro: Par)
ultimately show ?case by blast
next
case(cComm2 Q' T' a b x)
have "P ↝[Rel] Q" and "Q ⟼a[b] ≺ Q'" by fact+
then obtain P' where PTrans: "P ⟼a[b] ≺ P'" and PRel: "(P', Q') ∈ Rel"
by(blast dest: simE)
from ‹x ♯ (P, R)› have "x ♯ R" by simp
with ‹R ↝[Rel'] T› ‹T ⟼a<x> ≺ T'›
obtain R' where RTrans: "R ⟼a<x> ≺ R'"
and Rderivative: "derivative R' T' (InputS a) x Rel'"
by(blast dest: simE)
from Rderivative have RRel: "(R'[x::=b], T'[x::=b]) ∈ Rel'" by(simp add: derivative_def)
from PTrans RTrans have "P ∥ R ⟼ τ ≺ P' ∥ R'[x::=b]" by(rule Late_Semantics.Comm2)
moreover from PRel RRel have "(P' ∥ R'[x::=b], Q' ∥ T'[x::=b]) ∈ Rel''" by(blast intro: Par)
ultimately show "∃P'. P ∥ R ⟼ τ ≺ P' ∧ (P', Q' ∥ T'[x::=b]) ∈ Rel''" by blast
next
case(cClose1 Q' T' a x y)
from ‹x ♯ (P, R)› have "x ♯ P" by simp
with ‹P ↝[Rel] Q› ‹Q ⟼a<x> ≺ Q'›
obtain P' where PTrans: "P ⟼a<x> ≺ P'"
and Pderivative: "derivative P' Q' (InputS a) x Rel"
by(blast dest: simE)
from Pderivative have PRel: "(P'[x::=y], Q'[x::=y]) ∈ Rel" by(simp add: derivative_def)
from ‹y ♯ (P, R)› have "y ♯ R" and "y ♯ P" by simp+
from ‹R ↝[Rel'] T› ‹T ⟼a<νy> ≺ T'› ‹y ♯ R›
obtain R' where RTrans: "R ⟼a<νy> ≺ R'"
and Rderivative: "derivative R' T' (BoundOutputS a) y Rel'"
by(blast dest: simE)
from Rderivative have RRel: "(R', T') ∈ Rel'" by(simp add: derivative_def)
from PTrans RTrans ‹y ♯ P› have Trans: "P ∥ R ⟼ τ ≺ <νy>(P'[x::=y] ∥ R')"
by(rule Late_Semantics.Close1)
moreover from PRel RRel have "(<νy>(P'[x::=y] ∥ R'), <νy>(Q'[x::=y] ∥ T')) ∈ Rel''"
by(blast intro: Par Res)
ultimately show ?case by blast
next
case(cClose2 Q' T' a x y)
from ‹y ♯ (P, R)› have "y ♯ P" and "y ♯ R" by simp+
from ‹P ↝[Rel] Q› ‹Q ⟼a<νy> ≺ Q'› ‹y ♯ P›
obtain P' where PTrans: "P ⟼a<νy> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(force dest: simE simp add: derivative_def)
from ‹x ♯ (P, R)› have "x ♯ R" by simp+
with ‹R ↝[Rel'] T› ‹T ⟼a<x> ≺ T'›
obtain R' where RTrans: "R ⟼a<x> ≺ R'"
and R'Rel'T': "(R'[x::=y], T'[x::=y]) ∈ Rel'"
by(force dest: simE simp add: derivative_def)
from PTrans RTrans ‹y ♯ R› have Trans: "P ∥ R ⟼ τ ≺ <νy>(P' ∥ R'[x::=y])"
by(rule Close2)
moreover from P'RelQ' R'Rel'T' have "(<νy>(P' ∥ R'[x::=y]), <νy>(Q' ∥ T'[x::=y])) ∈ Rel''"
by(blast intro: Par Res)
ultimately show ?case by blast
qed
qed
lemma parPres:
fixes P :: pi
and Q :: pi
and R :: pi
and a :: name
and b :: name
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes PSimQ: "P ↝[Rel] Q"
and PRelQ: "(P, Q) ∈ Rel"
and Par: "⋀P Q R. (P, Q) ∈ Rel ⟹ (P ∥ R, Q ∥ R) ∈ Rel'"
and Res: "⋀P Q a. (P, Q) ∈ Rel' ⟹ (<νa>P, <νa>Q) ∈ Rel'"
and EqvtRel: "eqvt Rel"
and EqvtRel': "eqvt Rel'"
shows "P ∥ R ↝[Rel'] Q ∥ R"
proof -
note PSimQ
moreover have RSimR: "R ↝[Id] R" by(auto intro: reflexive)
moreover note PRelQ moreover have "(R, R) ∈ Id" by auto
moreover from Par have "⋀P Q R T. ⟦(P, Q) ∈ Rel; (R, T) ∈ Id⟧ ⟹ (P ∥ R, Q ∥ T) ∈ Rel'"
by auto
moreover note Res ‹eqvt Rel›
moreover have "eqvt Id" by(auto simp add: eqvt_def)
ultimately show ?thesis using EqvtRel' by(rule parCompose)
qed
lemma resDerivative:
fixes P :: pi
and Q :: pi
and a :: subject
and x :: name
and y :: name
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes Der: "derivative P Q a x Rel"
and Rel: "⋀(P::pi) (Q::pi) (x::name). (P, Q) ∈ Rel ⟹ (<νx>P, <νx>Q) ∈ Rel'"
and Eqv: "eqvt Rel"
shows "derivative (<νy>P) (<νy>Q) a x Rel'"
proof -
from Der Rel show ?thesis
proof(cases a, auto simp add: derivative_def)
fix u
assume A1: "∀u. (P[x::=u], Q[x::=u]) ∈ Rel"
show "((<νy>P)[x::=u], (<νy>Q)[x::=u]) ∈ Rel'"
proof(cases "x=y")
assume xeqy: "x=y"
from A1 have "(P[x::=x], Q[x::=x]) ∈ Rel" by blast
hence L1: "(<νy>P, <νy>Q) ∈ Rel'" by(force intro: Rel)
have "y ♯ <νy>P" and "y ♯ <νy>Q" by(simp only: freshRes)+
hence "(<νy>P)[y::=u] = <νy>P" and "(<νy>Q)[y::=u] = <νy>Q" by(simp add: forget)+
with L1 xeqy show ?thesis by simp
next
assume xineqy: "x≠y"
show ?thesis
proof(cases "y=u")
assume yequ: "y=u"
have "∃(c::name). c ♯ (P, Q, x, y)" by(blast intro: name_exists_fresh)
then obtain c where cFreshP: "c ♯ P" and cFreshQ: "c ♯ Q" and cineqx: "c ≠ x" and cineqy: "y ≠ c"
by(force simp add: fresh_prod name_fresh)
from A1 have "(P[x::=c], Q[x::=c]) ∈ Rel" by blast
with Eqv have "([(y, c)] ∙ (P[x::=c]), [(y, c)] ∙ (Q[x::=c])) ∈ Rel" by(rule eqvtRelI)
with xineqy cineqx cineqy have "(([(y, c)] ∙ P)[x::=y], ([(y, c)] ∙ Q)[x::=y]) ∈ Rel"
by(simp add: eqvt_subs name_calc)
hence "(<νc>(([(y, c)] ∙ P)[x::=y]), <νc>(([(y, c)] ∙ Q)[x::=y])) ∈ Rel'" by(rule Rel)
with cineqx cineqy have "((<νc>(([(y, c)] ∙ P)))[x::=y], (<νc>(([(y, c)] ∙ Q)))[x::=y])∈ Rel'" by simp
moreover from cFreshP cFreshQ have "<νc>([(y, c)] ∙ P) = <νy>P" and "<νc>([(y, c)] ∙ Q) = <νy>Q"
by(simp add: alphaRes)+
ultimately show ?thesis using yequ by simp
next
assume yinequ: "y ≠ u"
from A1 have "(P[x::=u], Q[x::=u]) ∈ Rel" by blast
hence "(<νy>(P[x::=u]), <νy>(Q[x::=u])) ∈ Rel'" by(rule Rel)
with xineqy yinequ show ?thesis by simp
qed
qed
qed
qed
lemma resPres:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and x :: name
and Rel' :: "(pi × pi) set"
assumes PSimQ: "P ↝[Rel] Q"
and ResRel: "⋀(P::pi) (Q::pi) (x::name). (P, Q) ∈ Rel ⟹ (<νx>P, <νx>Q) ∈ Rel'"
and RelRel': "Rel ⊆ Rel'"
and EqvtRel: "eqvt Rel"
and EqvtRel': "eqvt Rel'"
shows "<νx>P ↝[Rel'] <νx>Q"
using EqvtRel'
proof(induct rule: resSimCases[of _ _ _ _ "(P, x)"])
case(BoundOutput Q' a)
have QTrans: "Q ⟼a[x] ≺ Q'" and aineqx: "a ≠ x" by fact+
from PSimQ QTrans obtain P' where PTrans: "P ⟼ a[x] ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans aineqx have "<νx>P ⟼a<νx> ≺ P'" by(rule Late_Semantics.Open)
moreover from P'RelQ' RelRel' have "(P', Q') ∈ Rel'" by force
ultimately show ?case by blast
next
case(BoundR Q' a y)
have QTrans: "Q ⟼a«y» ≺ Q'" and xFresha: "x ♯ a" by fact+
have "y ♯ (P, x)" by fact
hence yFreshP: "y ♯ P" and yineqx: "y ≠ x" by(simp add: fresh_prod)+
from PSimQ yFreshP QTrans obtain P' where PTrans: "P ⟼a«y» ≺ P'"
and Pderivative: "derivative P' Q' a y Rel"
by(blast dest: simE)
from PTrans xFresha yineqx have ResTrans: "<νx>P ⟼a«y» ≺ <νx>P'"
by(blast intro: Late_Semantics.ResB)
moreover from Pderivative ResRel EqvtRel have "derivative (<νx>P') (<νx>Q') a y Rel'"
by(rule resDerivative)
ultimately show ?case by blast
next
case(FreeR Q' α)
have QTrans: "Q ⟼ α ≺ Q'" and xFreshAlpha: "(x::name) ♯ α" by fact+
from QTrans PSimQ obtain P' where PTrans: "P ⟼ α ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans xFreshAlpha have "<νx>P ⟼α ≺ <νx>P'" by(rule Late_Semantics.ResF)
moreover from P'RelQ' have "(<νx>P', <νx>Q') ∈ Rel'" by(rule ResRel)
ultimately show ?case by blast
qed
lemma resChainI:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and xs :: "name list"
assumes PRelQ: "P ↝[Rel] Q"
and eqvtRel: "eqvt Rel"
and Res: "⋀P Q x. (P, Q) ∈ Rel ⟹ (<νx>P, <νx>Q) ∈ Rel"
shows "(resChain xs) P ↝[Rel] (resChain xs) Q"
proof(induct xs)
from PRelQ show "resChain [] P ↝[Rel] resChain [] Q" by simp
next
fix x xs
assume IH: "(resChain xs P) ↝[Rel] (resChain xs Q)"
moreover note Res
moreover have "Rel ⊆ Rel" by simp
ultimately have "<νx>(resChain xs P) ↝[Rel] <νx>(resChain xs Q)" using eqvtRel
by(rule_tac resPres)
thus "resChain (x # xs) P ↝[Rel] resChain (x # xs) Q"
by simp
qed
lemma bangPres:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
assumes PRelQ: "(P, Q) ∈ Rel"
and Sim: "⋀P Q. (P, Q) ∈ Rel ⟹ P ↝[Rel] Q"
and eqvtRel: "eqvt Rel"
shows "!P ↝[bangRel Rel] !Q"
proof -
let ?Sim = "λP Rs. (∀a x Q'. Rs = a«x» ≺ Q' ⟶ x ♯ P ⟶ (∃P'. P ⟼a«x» ≺ P' ∧ derivative P' Q' a x (bangRel Rel))) ∧
(∀α Q'. Rs = α ≺ Q' ⟶ (∃P'. P ⟼α ≺ P' ∧ (P', Q') ∈ bangRel Rel))"
from eqvtRel have EqvtBangRel: "eqvt(bangRel Rel)" by(rule eqvtBangRel)
{
fix Pa Rs
assume "!Q ⟼ Rs" and "(Pa, !Q) ∈ bangRel Rel"
hence "?Sim Pa Rs" using PRelQ
proof(nominal_induct avoiding: Pa P rule: bangInduct)
case(cPar1B a x Q' Pa P)
have QTrans: "Q ⟼ a«x» ≺ Q'" by fact
have "(Pa, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ Pa" by fact+
thus "?Sim Pa (a«x» ≺ (Q' ∥ !Q))"
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" by fact
have PBRQ: "(R, !Q) ∈ bangRel Rel" by fact
have "x ♯ P ∥ R" by fact
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by simp+
show ?case
proof(auto simp add: residual.inject alpha')
from PRelQ have "P ↝[Rel] Q" by(rule Sim)
with QTrans xFreshP obtain P' where PTrans: "P ⟼ a«x» ≺ P'" and P'RelQ': "derivative P' Q' a x Rel"
by(blast dest: simE)
from PTrans xFreshR have "P ∥ R ⟼ a«x» ≺ (P' ∥ R)"
by(force intro: Late_Semantics.Par1B)
moreover from P'RelQ' PBRQ ‹x ♯ Q› ‹x ♯ R› have "derivative (P' ∥ R) (Q' ∥ !Q) a x (bangRel Rel)"
by(cases a) (auto simp add: derivative_def forget intro: Rel.BRPar)
ultimately show "∃P'. P ∥ R ⟼a«x» ≺ P' ∧ derivative P' (Q' ∥ !Q) a x (bangRel Rel)" by blast
next
fix y
assume "(y::name) ♯ Q'" and "y ♯ P" and "y ♯ R" and "y ♯ Q"
from QTrans ‹y ♯ Q'› have "Q ⟼a«y» ≺ ([(x, y)] ∙ Q')"
by(simp add: alphaBoundResidual)
moreover from PRelQ have "P ↝[Rel] Q" by(rule Sim)
ultimately obtain P' where PTrans: "P ⟼a«y» ≺ P'" and P'RelQ': "derivative P' ([(x, y)] ∙ Q') a y Rel"
using ‹y ♯ P›
by(blast dest: simE)
from PTrans ‹y ♯ R› have "P ∥ R ⟼a«y» ≺ (P' ∥ R)" by(force intro: Late_Semantics.Par1B)
moreover from P'RelQ' PBRQ ‹y ♯ Q› ‹y ♯ R› have "derivative (P' ∥ R) (([(x, y)] ∙ Q') ∥ !Q) a y (bangRel Rel)"
by(cases a) (auto simp add: derivative_def forget intro: Rel.BRPar)
with ‹x ♯ Q› ‹y ♯ Q› have "derivative (P' ∥ R) (([(y, x)] ∙ Q') ∥ !([(y, x)] ∙ Q)) a y (bangRel Rel)"
by(simp add: name_fresh_fresh name_swap)
ultimately show "∃P'. P ∥ R ⟼a«y» ≺ P' ∧ derivative P' (([(y, x)] ∙ Q') ∥ !([(y, x)] ∙ Q)) a y (bangRel Rel)"
by blast
qed
qed
next
case(cPar1F α Q' Pa P)
have QTrans: "Q ⟼α ≺ Q'" by fact
have "(Pa, Q ∥ !Q) ∈ bangRel Rel" by fact
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and BR: "(R, !Q) ∈ bangRel Rel" by fact+
show ?case
proof(auto simp add: residual.inject)
from PRelQ have "P ↝[Rel] Q" by(rule Sim)
with QTrans obtain P' where PTrans: "P ⟼ α ≺ P'" and RRel: "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans have "P ∥ R ⟼ α ≺ P' ∥ R" by(rule Par1F)
moreover from RRel BR have "(P' ∥ R, Q' ∥ !Q) ∈ bangRel Rel" by(rule Rel.BRPar)
ultimately show "∃P'. P ∥ R ⟼ α ≺ P' ∧ (P', Q' ∥ !Q) ∈ bangRel Rel" by blast
qed
qed
next
case(cPar2B a x Q' Pa P)
hence IH: "⋀Pa. (Pa, !Q) ∈ bangRel Rel ⟹ ?Sim Pa (a«x» ≺ Q')" by simp
have "(Pa, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ Pa" by fact+
thus "?Sim Pa (a«x» ≺ (Q ∥ Q'))"
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBRQ: "(R, !Q) ∈ bangRel Rel" by fact+
have "x ♯ P ∥ R" by fact
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by simp+
from EqvtBangRel ‹x ♯ Q› show "?Sim (P ∥ R) (a«x» ≺ (Q ∥ Q'))"
proof(auto simp add: residual.inject alpha' name_fresh_fresh)
from RBRQ have "?Sim R (a«x» ≺ Q')" by(rule IH)
with xFreshR obtain R' where RTrans: "R ⟼ a«x» ≺ R'" and R'BRQ': "derivative R' Q' a x (bangRel Rel)"
by(auto simp add: residual.inject)
from RTrans xFreshP have "P ∥ R ⟼ a«x» ≺ (P ∥ R')" by(auto intro: Par2B)
moreover from PRelQ R'BRQ' ‹x ♯ Q› ‹x ♯ P› have "derivative (P ∥ R') (Q ∥ Q') a x (bangRel Rel)"
by(cases a) (auto simp add: derivative_def forget intro: Rel.BRPar)
ultimately show "∃P'. P ∥ R ⟼ a«x» ≺ P' ∧ derivative P' (Q ∥ Q') a x (bangRel Rel)" by blast
next
fix y
assume "(y::name) ♯ Q" and "y ♯ Q'" and "y ♯ P" and "y ♯ R"
from RBRQ have "?Sim R (a«x» ≺ Q')" by(rule IH)
with ‹y ♯ Q'› have "?Sim R (a«y» ≺ ([(x, y)] ∙ Q'))" by(simp add: alphaBoundResidual)
with ‹y ♯ R› obtain R' where RTrans: "R ⟼ a«y» ≺ R'" and R'BRQ': "derivative R' ([(x, y)] ∙ Q') a y (bangRel Rel)"
by(auto simp add: residual.inject)
from RTrans ‹y ♯ P› have "P ∥ R ⟼ a«y» ≺ (P ∥ R')" by(auto intro: Par2B)
moreover from PRelQ R'BRQ' ‹y ♯ P› ‹y ♯ Q› have "derivative (P ∥ R') (Q ∥ ([(x, y)] ∙ Q')) a y (bangRel Rel)"
by(cases a) (auto simp add: derivative_def forget intro: Rel.BRPar)
hence "derivative (P ∥ R') (Q ∥ ([(y, x)] ∙ Q')) a y (bangRel Rel)"
by(simp add: name_swap)
ultimately show "∃P'. P ∥ R ⟼ a«y» ≺ P' ∧ derivative P' (Q ∥ ([(y, x)] ∙ Q')) a y (bangRel Rel)" by blast
qed
qed
next
case(cPar2F α Q' Pa P)
hence IH: "⋀Pa. (Pa, !Q) ∈ bangRel Rel ⟹ ?Sim Pa (α ≺ Q')" by simp
have "(Pa, Q ∥ !Q) ∈ bangRel Rel" by fact
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBRQ: "(R, !Q) ∈ bangRel Rel" by fact+
show ?case
proof(auto simp add: residual.inject)
from RBRQ IH have "∃R'. R ⟼ α ≺ R' ∧ (R', Q') ∈ bangRel Rel"
by(metis simE)
then obtain R' where RTrans: "R ⟼ α ≺ R'" and R'RelQ': "(R', Q') ∈ bangRel Rel"
by blast
from RTrans have "P ∥ R ⟼ α ≺ P ∥ R'" by(rule Par2F)
moreover from PRelQ R'RelQ' have "(P ∥ R', Q ∥ Q') ∈ bangRel Rel" by(rule Rel.BRPar)
ultimately show " ∃P'. P ∥ R ⟼ α ≺ P' ∧ (P', Q ∥ Q') ∈ bangRel Rel" by blast
qed
qed
next
case(cComm1 a x Q' b Q'' Pa P)
hence IH: "⋀Pa. (Pa, !Q) ∈ bangRel Rel ⟹ ?Sim Pa (a[b] ≺ Q'')" by simp
have QTrans: "Q ⟼a<x> ≺ Q'" by fact
have "(Pa, Q ∥ !Q) ∈ bangRel Rel" by fact
thus ?case using ‹x ♯ Pa›
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBRQ: "(R, !Q) ∈ bangRel Rel" by fact+
from ‹x ♯ P ∥ R› have "x ♯ P" and "x ♯ R" by simp+
show ?case
proof(auto simp add: residual.inject)
from PRelQ have "P ↝[Rel] Q" by(rule Sim)
with QTrans ‹x ♯ P› obtain P' where PTrans: "P ⟼ a<x> ≺ P'" and P'RelQ': "(P'[x::=b], Q'[x::=b]) ∈ Rel"
by(drule_tac simE) (auto simp add: derivative_def)
from IH RBRQ have RTrans: "∃R'. R ⟼ a[b] ≺ R' ∧ (R', Q'') ∈ bangRel Rel"
by(auto simp add: derivative_def)
then obtain R' where RTrans: "R ⟼ a[b] ≺ R'" and R'RelQ'': "(R', Q'') ∈ bangRel Rel"
by blast
from PTrans RTrans have "P ∥ R ⟼τ ≺ P'[x::=b] ∥ R'" by(rule Comm1)
moreover from P'RelQ' R'RelQ'' have "(P'[x::=b] ∥ R', Q'[x::=b] ∥ Q'') ∈ bangRel Rel" by(rule Rel.BRPar)
ultimately show "∃P'. P ∥ R ⟼ τ ≺ P' ∧ (P', Q'[x::=b] ∥ Q'') ∈ bangRel Rel" by blast
qed
qed
next
case(cComm2 a b Q' x Q'' Pa P)
hence IH: "⋀Pa. (Pa, !Q) ∈ bangRel Rel ⟹ ?Sim Pa (a<x> ≺ Q'')" by simp
have QTrans: "Q ⟼ a[b] ≺ Q'" by fact
have "(Pa, Q ∥ !Q) ∈ bangRel Rel" by fact
thus ?case using ‹x ♯ Pa›
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBRQ: "(R, !Q) ∈ bangRel Rel" by fact+
from ‹x ♯ P ∥ R› have "x ♯ P" and "x ♯ R" by simp+
show ?case
proof(auto simp add: residual.inject)
from PRelQ have "P ↝[Rel] Q" by(rule Sim)
with QTrans obtain P' where PTrans: "P ⟼ a[b] ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from IH RBRQ ‹x ♯ R› have RTrans: "∃R'. R ⟼ a<x> ≺ R' ∧ (R'[x::=b], Q''[x::=b]) ∈ bangRel Rel"
by(fastforce simp add: derivative_def residual.inject)
then obtain R' where RTrans: "R ⟼ a<x> ≺ R'" and R'RelQ'': "(R'[x::=b], Q''[x::=b]) ∈ bangRel Rel"
by blast
from PTrans RTrans have "P ∥ R ⟼ τ ≺ P' ∥ R'[x::=b]" by(rule Comm2)
moreover from P'RelQ' R'RelQ'' have "(P' ∥ R'[x::=b], Q' ∥ Q''[x::=b]) ∈ bangRel Rel" by(rule Rel.BRPar)
ultimately show "∃P'. P ∥ R ⟼ τ ≺ P' ∧ (P', Q' ∥ (Q''[x::=b])) ∈ bangRel Rel" by blast
qed
qed
next
case(cClose1 a x Q' y Q'' Pa P)
hence IH: "⋀Pa. (Pa, !Q) ∈ bangRel Rel ⟶ ?Sim Pa (a<νy> ≺ Q'')" by simp
have QTrans: "Q ⟼ a<x> ≺ Q'" by fact
have "(Pa, Q ∥ !Q) ∈ bangRel Rel" by fact
moreover have xFreshPa: "x ♯ Pa" by fact
ultimately show ?case using ‹y ♯ Pa›
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBRQ: "(R, !Q) ∈ bangRel Rel" by fact+
have "x ♯ P ∥ R" and "y ♯ P ∥ R" by fact+
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" and "y ♯ R" and "y ♯ P" by simp+
show ?case
proof(auto simp add: residual.inject)
from PRelQ have "P ↝[Rel] Q" by(rule Sim)
with QTrans xFreshP obtain P' where PTrans: "P ⟼a<x> ≺ P'" and P'RelQ': "(P'[x::=y], Q'[x::=y]) ∈ Rel"
by(fastforce dest: simE simp add: derivative_def)
from RBRQ ‹y ♯ R› IH have "∃R'. R ⟼a<νy> ≺ R' ∧ (R', Q'') ∈ bangRel Rel"
by(auto simp add: residual.inject derivative_def)
then obtain R' where RTrans: "R ⟼a<νy> ≺ R'" and R'RelQ'': "(R', Q'') ∈ bangRel Rel"
by blast
from PTrans RTrans ‹y ♯ P› have "P ∥ R ⟼τ ≺ <νy>(P'[x::=y] ∥ R')"
by(rule Close1)
moreover from P'RelQ' R'RelQ'' have "(<νy>(P'[x::=y] ∥ R'), <νy>(Q'[x::=y] ∥ Q'')) ∈ bangRel Rel"
by(force intro: Rel.BRPar BRRes)
ultimately show "∃P'. P ∥ R ⟼ τ ≺ P' ∧ (P', <νy>(Q'[x::=y] ∥ Q'')) ∈ bangRel Rel" by blast
qed
qed
next
case(cClose2 a x Q' y Q'' Pa P)
hence IH: "⋀Pa. (Pa, !Q) ∈ bangRel Rel ⟹ ?Sim Pa (a<y> ≺ Q'')" by simp
have QTrans: "Q ⟼ a<νx> ≺ Q'" by fact
have "(Pa, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ Pa" and "y ♯ Pa" by fact+
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBRQ: "(R, !Q) ∈ bangRel Rel" by fact+
have "x ♯ P ∥ R" and "y ♯ P ∥ R" by fact+
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" and "y ♯ R" by simp+
show ?case
proof(auto simp add: residual.inject)
from PRelQ have "P ↝[Rel] Q" by(rule Sim)
with QTrans xFreshP obtain P' where PTrans: "P ⟼a<νx> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(fastforce dest: simE simp add: derivative_def)
from RBRQ IH ‹y ♯ R› have "∃R'. R ⟼a<y> ≺ R' ∧ (R'[y::=x], Q''[y::=x]) ∈ bangRel Rel"
by(fastforce simp add: derivative_def residual.inject)
then obtain R' where RTrans: "R ⟼a<y> ≺ R'" and R'RelQ'': "(R'[y::=x], Q''[y::=x]) ∈ bangRel Rel"
by blast
from PTrans RTrans xFreshR have "P ∥ R ⟼ τ ≺ <νx>(P' ∥ R'[y::=x])"
by(rule Close2)
moreover from P'RelQ' R'RelQ'' have "(<νx>(P' ∥ R'[y::=x]), <νx>(Q' ∥ Q''[y::=x])) ∈ bangRel Rel"
by(force intro: Rel.BRPar BRRes)
ultimately show "∃P'. P ∥ R ⟼ τ ≺ P' ∧ (P', <νx>(Q' ∥ Q''[y::=x])) ∈ bangRel Rel" by blast
qed
qed
next
case(cBang Rs Pa P)
hence IH: "⋀Pa. (Pa, Q ∥ !Q) ∈ bangRel Rel ⟹ ?Sim Pa Rs" by simp
have "(Pa, !Q) ∈ bangRel Rel" by fact
thus ?case
proof(induct rule: BRBangCases)
case(BRBang P)
have PRelQ: "(P, Q) ∈ Rel" by fact
hence "(!P, !Q) ∈ bangRel Rel" by(rule Rel.BRBang)
with PRelQ have "(P ∥ !P, Q ∥ !Q) ∈ bangRel Rel" by(rule BRPar)
with IH have "?Sim (P ∥ !P) Rs" by simp
thus ?case by(force intro: Bang)
qed
qed
}
moreover from PRelQ have "(!P, !Q) ∈ bangRel Rel" by(rule BRBang)
ultimately show ?thesis by(auto simp add: simulation_def)
qed
end
Theory Strong_Late_Bisim_Pres
theory Strong_Late_Bisim_Pres
imports Strong_Late_Bisim Strong_Late_Sim_Pres
begin
lemma tauPres:
fixes P :: pi
and Q :: pi
assumes "P ∼ Q"
shows "τ.(P) ∼ τ.(Q)"
proof -
let ?X = "{(τ.(P), τ.(Q)), (τ.(Q), τ.(P))}"
have "(τ.(P), τ.(Q)) ∈ ?X" by auto
thus ?thesis using ‹P ∼ Q›
by(coinduct rule: bisimCoinduct)
(auto intro: Strong_Late_Sim_Pres.tauPres dest: symmetric)
qed
lemma inputPres:
fixes P :: pi
and Q :: pi
and a :: name
and x :: name
assumes PSimQ: "∀y. P[x::=y] ∼ Q[x::=y]"
shows "a<x>.P ∼ a<x>.Q"
proof -
let ?X = "{(a<x>.P, a<x>.Q) | a x P Q. ∀y. P[x::=y] ∼ Q[x::=y]}"
{
fix axP axQ p
assume "(axP, axQ) ∈ ?X"
then obtain a x P Q where A: "∀y. P[x::=y] ∼ Q[x::=y]" and B: "axP = a<x>.P" and C: "axQ = a<x>.Q"
by auto
have "⋀y. ((p::name prm) ∙ P)[(p ∙ x)::=y] ∼ (p ∙ Q)[(p ∙ x)::=y]"
proof -
fix y
from A have "P[x::=(rev p ∙ y)] ∼ Q[x::=(rev p ∙ y)]"
by blast
hence "(p ∙ (P[x::=(rev p ∙ y)])) ∼ p ∙ (Q[x::=(rev p ∙ y)])"
by(rule bisimClosed)
thus "(p ∙ P)[(p ∙ x)::=y] ∼ (p ∙ Q)[(p ∙ x)::=y]"
by(simp add: eqvts pt_pi_rev[OF pt_name_inst, OF at_name_inst])
qed
hence "((p::name prm) ∙ axP, p ∙ axQ) ∈ ?X" using B C
by auto
}
hence "eqvt ?X" by(simp add: eqvt_def)
from PSimQ have "(a<x>.P, a<x>.Q) ∈ ?X" by auto
thus ?thesis
proof(coinduct rule: bisimCoinduct)
case(cSim P Q)
thus ?case using ‹eqvt ?X›
by(force intro: inputPres)
next
case(cSym P Q)
thus ?case
by(blast dest: symmetric)
qed
qed
lemma outputPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
assumes "P ∼ Q"
shows "a{b}.P ∼ a{b}.Q"
proof -
let ?X = "{(a{b}.P, a{b}.Q), (a{b}.Q, a{b}.P)}"
have "(a{b}.P, a{b}.Q) ∈ ?X" by auto
thus ?thesis using ‹P ∼ Q›
by(coinduct rule: bisimCoinduct)
(auto intro: Strong_Late_Sim_Pres.outputPres dest: symmetric)
qed
lemma matchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
assumes "P ∼ Q"
shows "[a⌢b]P ∼ [a⌢b]Q"
proof -
let ?X = "{([a⌢b]P, [a⌢b]Q), ([a⌢b]Q, [a⌢b]P)}"
have "([a⌢b]P, [a⌢b]Q) ∈ ?X" by auto
thus ?thesis using ‹P ∼ Q›
by(coinduct rule: bisimCoinduct)
(auto intro: Strong_Late_Sim_Pres.matchPres dest: symmetric bisimE)
qed
lemma mismatchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
assumes "P ∼ Q"
shows "[a≠b]P ∼ [a≠b]Q"
proof -
let ?X = "{([a≠b]P, [a≠b]Q), ([a≠b]Q, [a≠b]P)}"
have "([a≠b]P, [a≠b]Q) ∈ ?X" by auto
thus ?thesis using ‹P ∼ Q›
by(coinduct rule: bisimCoinduct)
(auto intro: Strong_Late_Sim_Pres.mismatchPres dest: symmetric bisimE)
qed
lemma sumPres:
fixes P :: pi
and Q :: pi
and R :: pi
assumes "P ∼ Q"
shows "P ⊕ R ∼ Q ⊕ R"
proof -
let ?X = "{(P ⊕ R, Q ⊕ R), (Q ⊕ R, P ⊕ R)}"
have "(P ⊕ R, Q ⊕ R) ∈ ?X" by auto
thus ?thesis using ‹P ∼ Q›
by(coinduct rule: bisimCoinduct)
(auto intro: Strong_Late_Sim_Pres.sumPres reflexive dest: symmetric bisimE)
qed
lemma resPres:
fixes P :: pi
and Q :: pi
and x :: name
assumes "P ∼ Q"
shows "<νx>P ∼ <νx>Q"
proof -
let ?X = "{x. ∃P Q. P ∼ Q ∧ (∃a. x = (<νa>P, <νa>Q))}"
from ‹P ∼ Q› have "(<νx>P, <νx>Q) ∈ ?X" by blast
thus ?thesis
proof(coinduct rule: bisimCoinduct)
case(cSim xP xQ)
{
fix P Q a
assume PSimQ: "P ↝[bisim] Q"
moreover have "⋀P Q a. P ∼ Q ⟹ (<νa>P, <νa>Q) ∈ ?X ∪ bisim" by blast
moreover have "bisim ⊆ ?X ∪ bisim" by blast
moreover have "eqvt bisim" by simp
moreover have "eqvt ?X"
by(auto simp add: eqvt_def) (blast intro: bisimClosed)
hence "eqvt (?X ∪ bisim)" by auto
ultimately have "<νa>P ↝[(?X ∪ bisim)] <νa>Q"
by(rule Strong_Late_Sim_Pres.resPres)
}
with ‹(xP, xQ) ∈ ?X› show ?case
by(auto dest: bisimE)
next
case(cSym xP xQ)
thus ?case by(auto dest: symmetric)
qed
qed
lemma parPres:
fixes P :: pi
and Q :: pi
and R :: pi
assumes "P ∼ Q"
shows "P ∥ R ∼ Q ∥ R"
proof -
let ?X = "{(resChain lst (P ∥ R), resChain lst (Q ∥ R)) | lst P R Q. P ∼ Q}"
have EmptyChain: "⋀P Q. P ∥ Q = resChain [] (P ∥ Q)" by auto
with ‹P ∼ Q› have "(P ∥ R, Q ∥ R) ∈ ?X" by blast
thus ?thesis
proof(coinduct rule: bisimCoinduct)
case(cSim PR QR)
{
fix P Q R lst
assume "P ∼ Q"
hence "P ↝[bisim] Q" by(rule bisimE)
moreover note ‹P ∼ Q›
moreover have "⋀P Q R. P ∼ Q ⟹ (P ∥ R, Q ∥ R) ∈ ?X"
by auto (blast intro: EmptyChain)
moreover
{
fix xP xQ x
assume "(xP, xQ) ∈ ?X"
then obtain P Q R lst
where "P ∼ Q" and "xP = resChain lst (P ∥ R)" and xQeq: "xQ = resChain lst (Q ∥ R)"
by auto
moreover hence "(resChain (x#lst) (P ∥ R), resChain (x#lst) (Q ∥ R)) ∈ ?X"
by blast
ultimately have "(<νx>xP, <νx>xQ) ∈ ?X" by auto
}
note ResPres = this
moreover have "eqvt bisim" by simp
moreover have "eqvt ?X"
by(auto simp add: eqvt_def) (blast intro: bisimClosed)
ultimately have "P ∥ R ↝[(?X)] Q ∥ R" by(rule parPres)
hence "resChain lst (P ∥ R) ↝[?X] (resChain lst (Q ∥ R))" using ‹eqvt ?X› ResPres
by(rule resChainI)
hence "resChain lst (P ∥ R) ↝[(?X ∪ bisim)] (resChain lst (Q ∥ R))"
by(force intro: Strong_Late_Sim.monotonic)
}
with ‹(PR, QR) ∈ ?X› show ?case
by auto
next
case(cSym PR QR)
thus ?case by(blast dest: symmetric)
qed
qed
lemma bangPres:
fixes P :: pi
and Q :: pi
assumes PBiSimQ: "P ∼ Q"
shows "!P ∼ !Q"
proof -
let ?X = "bangRel bisim"
from PBiSimQ have "(!P, !Q) ∈ ?X" by(rule Rel.BRBang)
thus ?thesis
proof(coinduct rule: bisimCoinduct)
case(cSim bP bQ)
{
fix P Q
assume "(P, Q) ∈ ?X"
hence "P ↝[?X] Q"
proof(induct)
fix P Q
assume "P ∼ Q"
thus "!P ↝[?X] !Q" using bisimE bisimEqvt
by(rule Strong_Late_Sim_Pres.bangPres)
next
fix P Q R T
assume RBiSimT: "R ∼ T"
assume PBangRelQ: "(P, Q) ∈ ?X"
assume PSimQ: "P ↝[?X] Q"
from RBiSimT have "R ↝[bisim] T" by(blast dest: bisimE)
thus "R ∥ P ↝[?X] T ∥ Q" using PSimQ RBiSimT PBangRelQ Rel.BRPar Rel.BRRes bisimEqvt eqvtBangRel
by(blast intro: Strong_Late_Sim_Pres.parCompose)
next
fix P Q a
assume "P ↝[?X] Q"
moreover from eqvtBangRel bisimEqvt have "eqvt ?X" by blast
ultimately show "<νa>P ↝[?X] <νa>Q" using Rel.BRRes by(blast intro: Strong_Late_Sim_Pres.resPres)
qed
hence "P ↝[((bangRel bisim) ∪ bisim)] Q" by(rule_tac Strong_Late_Sim.monotonic) auto
}
with ‹(bP, bQ) ∈ ?X› show ?case by auto
next
case(cSym bP bQ)
thus ?case by(metis bangRelSymetric symmetric)
qed
qed
end
Theory Strong_Late_Bisim_Subst_Pres
theory Strong_Late_Bisim_Subst_Pres
imports Strong_Late_Bisim_Subst Strong_Late_Bisim_Pres
begin
lemma tauPres:
fixes P :: pi
and Q :: pi
assumes "P ∼⇧s Q"
shows "τ.(P) ∼⇧s τ.(Q)"
using assms
by(force simp add: substClosed_def intro: Strong_Late_Bisim_Pres.tauPres)
lemma inputPres:
fixes P :: pi
and Q :: pi
and a :: name
and x :: name
assumes "P ∼⇧s Q"
shows "a<x>.P ∼⇧s a<x>.Q"
proof(auto simp add: substClosed_def)
fix σ :: "(name × name) list"
{
fix P Q a x σ
assume "P ∼⇧s Q"
then have "P[<σ>] ∼⇧s Q[<σ>]" by(rule partUnfold)
then have "∀y. (P[<σ>])[x::=y] ∼ (Q[<σ>])[x::=y]"
apply(auto simp add: substClosed_def)
by(erule_tac x="[(x, y)]" in allE) auto
moreover assume "x ♯ σ"
ultimately have "(a<x>.P)[<σ>] ∼ (a<x>.Q)[<σ>]" using bisimEqvt
by(force intro: Strong_Late_Bisim_Pres.inputPres)
}
note Goal = this
obtain y::name where "y ♯ P" and "y ♯ Q" and "y ♯ σ"
by(generate_fresh "name") auto
from ‹P ∼⇧s Q› have "([(x, y)] ∙ P) ∼⇧s ([(x, y)] ∙ Q)" by(rule eqClosed)
hence "(a<y>.([(x, y)] ∙ P))[<σ>] ∼ (a<y>.([(x, y)] ∙ Q))[<σ>]" using ‹y ♯ σ› by(rule Goal)
moreover from ‹y ♯ P› ‹y ♯ Q› have "a<x>.P = a<y>.([(x, y)] ∙ P)" and "a<x>.Q = a<y>.([(x, y)] ∙ Q)"
by(simp add: alphaInput)+
ultimately show "(a<x>.P)[<σ>] ∼ (a<x>.Q)[<σ>]" by simp
qed
lemma outputPres:
fixes P :: pi
and Q :: pi
assumes "P ∼⇧s Q"
shows "a{b}.P ∼⇧s a{b}.Q"
using assms
by(force simp add: substClosed_def intro: Strong_Late_Bisim_Pres.outputPres)
lemma matchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
assumes "P ∼⇧s Q"
shows "[a⌢b]P ∼⇧s [a⌢b]Q"
using assms
by(force simp add: substClosed_def intro: Strong_Late_Bisim_Pres.matchPres)
lemma mismatchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
assumes "P ∼⇧s Q"
shows "[a≠b]P ∼⇧s [a≠b]Q"
using assms
by(force simp add: substClosed_def intro: Strong_Late_Bisim_Pres.mismatchPres)
lemma sumPres:
fixes P :: pi
and Q :: pi
and R :: pi
assumes "P ∼⇧s Q"
shows "P ⊕ R ∼⇧s Q ⊕ R"
using assms
by(force simp add: substClosed_def intro: Strong_Late_Bisim_Pres.sumPres)
lemma parPres:
fixes P :: pi
and Q :: pi
and R :: pi
assumes "P ∼⇧s Q"
shows "P ∥ R ∼⇧s Q ∥ R"
using assms
by(force simp add: substClosed_def intro: Strong_Late_Bisim_Pres.parPres)
lemma resPres:
fixes P :: pi
and Q :: pi
and x :: name
assumes PeqQ: "P ∼⇧s Q"
shows "<νx>P ∼⇧s <νx>Q"
proof(auto simp add: substClosed_def)
fix s::"(name × name) list"
have Res: "⋀P Q x s. ⟦P[<s>] ∼ Q[<s>]; x ♯ s⟧ ⟹ (<νx>P)[<s>] ∼ (<νx>Q)[<s>]"
by(force intro: Strong_Late_Bisim_Pres.resPres)
have "∃c::name. c ♯ (P, Q, s)" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshP: "c ♯ P" and cFreshQ: "c ♯ Q" and cFreshs: "c ♯ s"
by(force simp add: fresh_prod)
from PeqQ have "P[<([(x, c)] ∙ s)>] ∼ Q[<([(x, c)] ∙ s)>]" by(simp add: substClosed_def)
hence "([(x, c)] ∙ P[<([(x, c)] ∙ s)>]) ∼ ([(x, c)] ∙ Q[<([(x, c)] ∙ s)>])" by(rule bisimClosed)
hence "([(x, c)] ∙ P)[<s>] ∼ ([(x, c)] ∙ Q)[<s>]" by simp
hence "(<νc>([(x, c)] ∙ P))[<s>] ∼ (<νc>([(x, c)] ∙ Q))[<s>]" using cFreshs by(rule Res)
moreover from cFreshP cFreshQ have "<νx>P = <νc>([(x, c)] ∙ P)" and "<νx>Q = <νc>([(x, c)] ∙ Q)"
by(simp add: alphaRes)+
ultimately show "(<νx>P)[<s>] ∼ (<νx>Q)[<s>]" by simp
qed
lemma bangPres:
fixes P :: pi
and Q :: pi
assumes "P ∼⇧s Q"
shows "!P ∼⇧s !Q"
using assms
by(force simp add: substClosed_def intro: Strong_Late_Bisim_Pres.bangPres)
end
Theory Late_Tau_Chain
theory Late_Tau_Chain
imports Late_Semantics1
begin
abbreviation "tauChain_judge" :: "pi ⇒ pi ⇒ bool" ("_ ⟹⇩τ _" [80, 80] 80)
where "P ⟹⇩τ P' ≡ (P, P') ∈ {(P, P') | P P'. P ⟼τ ≺ P'}^*"
lemma singleTauChain:
fixes P :: pi
and P' :: pi
assumes "P ⟼τ ≺ P'"
shows "P ⟹⇩τ P'"
using assms by(simp add: r_into_rtrancl)
lemma tauChainAddTau[dest]:
fixes P :: pi
and P' :: pi
and P'' :: pi
shows "P ⟹⇩τ P' ⟹ P' ⟼τ ≺ P'' ⟹ P ⟹⇩τ P''"
and "P ⟼τ ≺ P' ⟹ P' ⟹⇩τ P'' ⟹ P ⟹⇩τ P''"
by(auto dest: singleTauChain)
lemma tauChainInduct[consumes 1, case_names id ih]:
fixes P :: pi
and P' :: pi
assumes "P ⟹⇩τ P'"
and "F P"
and "⋀P' P''. ⟦P ⟹⇩τ P'; P' ⟼τ ≺ P''; F P'⟧ ⟹ F P''"
shows "F P'"
using assms
by(drule_tac rtrancl_induct) auto
lemma eqvtChainI[eqvt]:
fixes P :: pi
and P' :: pi
and perm :: "name prm"
assumes "P ⟹⇩τ P'"
shows "(perm ∙ P) ⟹⇩τ (perm ∙ P')"
using assms
proof(induct rule: tauChainInduct)
case id
thus ?case by simp
next
case(ih P'' P''')
have "P ⟹⇩τ P''" and "P'' ⟼ τ ≺ P'''" by fact+
hence "(perm ∙ P'') ⟼τ ≺ (perm ∙ P''')" by(force dest: transitions.eqvt)
moreover have "(perm ∙ P) ⟹⇩τ (perm ∙ P'')" by fact
ultimately show ?case by auto
qed
lemma eqvtChainE:
fixes perm :: "name prm"
and P :: pi
and P' :: pi
assumes Trans: "(perm ∙ P) ⟹⇩τ (perm ∙ P')"
shows "P ⟹⇩τ P'"
proof -
have "rev perm ∙ (perm ∙ P) = P" by(simp add: pt_rev_pi[OF pt_name_inst, OF at_name_inst])
moreover have "rev perm ∙ (perm ∙ P') = P'" by(simp add: pt_rev_pi[OF pt_name_inst, OF at_name_inst])
ultimately show ?thesis using assms
by(drule_tac perm="rev perm" in eqvtChainI, simp)
qed
lemma eqvtChainEq:
fixes P :: pi
and P' :: pi
and perm :: "name prm"
shows "P ⟹⇩τ P' = (perm ∙ P) ⟹⇩τ (perm ∙ P')"
by(blast intro: eqvtChainE eqvtChainI)
lemma freshChain:
fixes P :: pi
and P' :: pi
and x :: name
assumes "P ⟹⇩τ P'"
and "x ♯ P"
shows "x ♯ P'"
using assms
proof(induct rule: tauChainInduct)
case id
thus ?case by simp
next
case(ih P' P'')
have "x ♯ P" and "x ♯ P ⟹ x ♯ P'" by fact+
hence "x ♯ P'" by simp
moreover have "P' ⟼ τ ≺ P''" by fact
ultimately show ?case by(force intro: freshFreeDerivative)
qed
lemma matchChain:
fixes b :: name
and P :: pi
and P' :: pi
assumes "P ⟹⇩τ P'"
and "P ≠ P'"
shows "[b⌢b]P ⟹⇩τ P'"
using assms
proof(induct rule: tauChainInduct)
case id
thus ?case by simp
next
case(ih P'' P''')
have P''TransP''': "P'' ⟼τ ≺ P'''" by fact
show "[b⌢b]P ⟹⇩τ P'''"
proof(cases "P = P''")
assume "P=P''"
moreover with P''TransP''' have "[b⌢b]P ⟼τ ≺ P'''" by(force intro: Match)
thus "[b⌢b]P ⟹⇩τ P'''" by(rule singleTauChain)
next
assume "P ≠ P''"
moreover have "P ≠ P'' ⟹ [b⌢b]P ⟹⇩τ P''" by fact
ultimately show "[b⌢b]P ⟹⇩τ P'''" using P''TransP''' by(blast)
qed
qed
lemma mismatchChain:
fixes a :: name
and b :: name
and P :: pi
and P' :: pi
assumes PChain: "P ⟹⇩τ P'"
and aineqb: "a ≠ b"
and PineqP': "P ≠ P'"
shows "[a≠b]P ⟹⇩τ P'"
using PChain PineqP'
proof(induct rule: tauChainInduct)
case id
thus ?case by simp
next
case(ih P'' P''')
have P''TransP''': "P'' ⟼τ ≺ P'''" by fact
show "[a≠b]P ⟹⇩τ P'''"
proof(cases "P = P''")
assume "P=P''"
moreover with aineqb P''TransP''' have "[a≠b]P ⟼τ ≺ P'''" by(force intro: Mismatch)
thus "[a≠b]P ⟹⇩τ P'''" by(rule singleTauChain)
next
assume "P ≠ P''"
moreover have "P ≠ P'' ⟹ [a≠b]P ⟹⇩τ P''" by fact+
ultimately show "[a≠b]P ⟹⇩τ P'''" using P''TransP''' by(blast)
qed
qed
lemma sum1Chain[rule_format]:
fixes P :: pi
and P' :: pi
and Q :: pi
assumes "P ⟹⇩τ P'"
and "P ≠ P'"
shows "P ⊕ Q ⟹⇩τ P'"
using assms
proof(induct rule: tauChainInduct)
case id
thus ?case by simp
next
case(ih P'' P''')
have P''TransP''': "P'' ⟼τ ≺ P'''" by fact
show "P ⊕ Q ⟹⇩τ P'''"
proof(cases "P = P''")
assume "P=P''"
moreover with P''TransP''' have "P ⊕ Q ⟼τ ≺ P'''" by(force intro: Sum1)
thus "P ⊕ Q ⟹⇩τ P'''" by(force intro: singleTauChain)
next
assume "P ≠ P''"
moreover have "P ≠ P'' ⟹ P ⊕ Q ⟹⇩τ P''" by fact
ultimately show "P ⊕ Q ⟹⇩τ P'''" using P''TransP''' by(force)
qed
qed
lemma sum2Chain[rule_format]:
fixes P :: pi
and Q :: pi
and Q' :: pi
assumes "Q ⟹⇩τ Q'"
and "Q ≠ Q'"
shows "P ⊕ Q ⟹⇩τ Q'"
using assms
proof(induct rule: tauChainInduct)
case id
thus ?case by simp
next
case(ih Q'' Q''')
have Q''TransQ''': "Q'' ⟼τ ≺ Q'''" by fact
show "P ⊕ Q ⟹⇩τ Q'''"
proof(cases "Q = Q''")
assume "Q=Q''"
moreover with Q''TransQ''' have "P ⊕ Q ⟼τ ≺ Q'''" by(force intro: Sum2)
thus "P ⊕ Q ⟹⇩τ Q'''" by(force intro: singleTauChain)
next
assume "Q ≠ Q''"
moreover have "Q ≠ Q'' ⟹ P ⊕ Q ⟹⇩τ Q''" by fact
ultimately show "P ⊕ Q ⟹⇩τ Q'''" using Q''TransQ''' by blast
qed
qed
lemma Par1Chain:
fixes P :: pi
and P' :: pi
and Q :: pi
assumes "P ⟹⇩τ P'"
shows "P ∥ Q ⟹⇩τ P' ∥ Q"
using assms
proof(induct rule: tauChainInduct)
case id
thus ?case by simp
next
case(ih P'' P')
have P''TransP': "P'' ⟼τ ≺ P'" by fact
have IH: "P ∥ Q ⟹⇩τ P'' ∥ Q" by fact
have "P'' ∥ Q ⟼τ ≺ P' ∥ Q" using P''TransP' by(force intro: Par1F)
thus "P ∥ Q ⟹⇩τ P' ∥ Q" using IH by(force)
qed
lemma Par2Chain:
fixes P :: pi
and Q :: pi
and Q' :: pi
assumes "Q ⟹⇩τ Q'"
shows "P ∥ Q ⟹⇩τ P ∥ Q'"
using assms
proof(induct rule: tauChainInduct)
case id
thus ?case by simp
next
case(ih Q'' Q')
have Q''TransQ': "Q'' ⟼τ ≺ Q'" by fact
have IH: "P ∥ Q ⟹⇩τ P ∥ Q''" by fact
have "P ∥ Q'' ⟼τ ≺ P ∥ Q'" using Q''TransQ' by(force intro: Par2F)
thus "P ∥ Q ⟹⇩τ P ∥ Q'" using IH by(force)
qed
lemma chainPar:
fixes P :: pi
and P' :: pi
and Q :: pi
and Q' :: pi
assumes "P ⟹⇩τ P'"
and "Q ⟹⇩τ Q'"
shows "P ∥ Q ⟹⇩τ P' ∥ Q'"
proof -
from ‹P ⟹⇩τ P'› have "P ∥ Q ⟹⇩τ P' ∥ Q" by(rule Par1Chain)
moreover from ‹Q ⟹⇩τ Q'› have "P' ∥ Q ⟹⇩τ P' ∥ Q'" by(rule Par2Chain)
ultimately show ?thesis by auto
qed
lemma ResChain:
fixes P :: pi
and P' :: pi
and a :: name
assumes "P ⟹⇩τ P'"
shows "<νa>P ⟹⇩τ <νa>P'"
using assms
proof(induct rule: tauChainInduct)
case id
thus ?case by simp
next
case(ih P'' P''')
have "P'' ⟼τ ≺ P'''" by fact
hence "<νa>P'' ⟼τ ≺ <νa>P'''" by(force intro: ResF)
moreover have "<νa>P ⟹⇩τ <νa>P''" by fact
ultimately show ?case by force
qed
lemma substChain:
fixes P :: pi
and x :: name
and b :: name
and P' :: pi
assumes PTrans: "P[x::=b] ⟹⇩τ P'"
shows "P[x::=b] ⟹⇩τ P'[x::=b]"
proof(cases "x=b")
assume "x = b"
with PTrans show ?thesis by simp
next
assume "x ≠ b"
hence "x ♯ P[x::=b]" by(simp add: fresh_fact2)
with PTrans have "x ♯ P'" by(force intro: freshChain)
hence "P' = P'[x::=b]" by(simp add: forget)
with PTrans show ?thesis by simp
qed
lemma bangChain:
fixes P :: pi
and P' :: pi
assumes PTrans: "P ∥ !P ⟹⇩τ P'"
and P'ineq: "P' ≠ P ∥ !P"
shows "!P ⟹⇩τ P'"
using assms
proof(induct rule: tauChainInduct)
case id
thus ?case by simp
next
case(ih P' P'')
show ?case
proof(cases "P' = P ∥ !P")
case True
from ‹P' ⟼τ ≺ P''› ‹P' = P ∥ !P› have "!P ⟼τ ≺ P''" by(blast intro: Bang)
thus ?thesis by auto
next
case False
from ‹P' ≠ P ∥ !P› have "!P ⟹⇩τ P'" by(rule ih)
with ‹P' ⟼τ ≺ P''› show ?thesis by auto
qed
qed
end
Theory Weak_Late_Step_Semantics
theory Weak_Late_Step_Semantics
imports Late_Tau_Chain
begin
definition inputTransition :: "pi ⇒ name ⇒ pi ⇒ name ⇒ name ⇒ pi ⇒ bool" ("_ ⟹⇩l_ in _→_<_> ≺ _" [80, 80, 80, 80, 80] 80)
where "P ⟹⇩lu in P'' →a<x> ≺ P' ≡ ∃P'''. P ⟹⇩τ P''' ∧ P''' ⟼a<x> ≺ P'' ∧ P''[x::=u] ⟹⇩τ P'"
definition transition :: "(pi × Late_Semantics.residual) set" where
"transition ≡ {x. ∃P P' α P'' P'''. P ⟹⇩τ P' ∧ P' ⟼α ≺ P'' ∧ P'' ⟹⇩τ P''' ∧ x = (P, α ≺ P''')} ∪
{x. ∃P P' a y P'' P'''. P ⟹⇩τ P' ∧ (P' ⟼(a<νy> ≺ P'')) ∧ P'' ⟹⇩τ P''' ∧ x = (P, (a<νy> ≺ P'''))}"
abbreviation weakTransition_judge :: "pi ⇒ Late_Semantics.residual ⇒ bool" ("_ ⟹⇩l _" [80, 80] 80)
where "P ⟹⇩l Rs ≡ (P, Rs) ∈ transition"
lemma weakNonInput[dest]:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
assumes "P ⟹⇩la<x> ≺ P'"
shows False
using assms
by(auto simp add: transition_def residual.inject)
lemma transitionI:
fixes P :: pi
and P''' :: pi
and α :: freeRes
and P'' :: pi
and P' :: pi
and a :: name
and x :: name
and u :: name
shows "⟦P ⟹⇩τ P'''; P''' ⟼α ≺ P''; P'' ⟹⇩τ P'⟧ ⟹ P ⟹⇩lα ≺ P'"
and "⟦P ⟹⇩τ P'''; P''' ⟼a<νx> ≺ P''; P'' ⟹⇩τ P'⟧ ⟹ P ⟹⇩la<νx> ≺ P'"
and "⟦P ⟹⇩τ P'''; P''' ⟼a<x> ≺ P''; P''[x::=u] ⟹⇩τ P'⟧ ⟹ P ⟹⇩lu in P''→a<x> ≺ P'"
proof -
assume "P ⟹⇩τ P'''" and "P''' ⟼ α ≺ P''" and "P'' ⟹⇩τ P'"
thus "P ⟹⇩l α ≺ P'"
by(force simp add: transition_def)
next
assume "P ⟹⇩τ P'''" and "P''' ⟼a<νx> ≺ P''" and "P'' ⟹⇩τ P'"
thus "P ⟹⇩la<νx> ≺ P'"
by(force simp add: transition_def)
next
assume "P ⟹⇩τ P'''" and "P''' ⟼a<x> ≺ P''" and "P''[x::=u] ⟹⇩τ P'"
thus "P ⟹⇩lu in P''→a<x> ≺ P'"
by(force simp add: inputTransition_def)
qed
lemma transitionE:
fixes P :: pi
and α :: freeRes
and P' :: pi
and P'' :: pi
and a :: name
and u :: name
and x :: name
shows "P ⟹⇩lα ≺ P' ⟹ ∃P'' P'''. P ⟹⇩τ P'' ∧ P'' ⟼α ≺ P''' ∧ P''' ⟹⇩τ P'" (is "_ ⟹ ?thesis1")
and "⟦P ⟹⇩la<νx> ≺ P'; x ♯ P⟧ ⟹ ∃P'' P'''. P ⟹⇩τ P''' ∧ P''' ⟼a<νx> ≺ P'' ∧ P'' ⟹⇩τ P'"
and "⟦P ⟹⇩lu in P''→a<x> ≺ P'⟧ ⟹ ∃P'''. P ⟹⇩τ P''' ∧ P''' ⟼a<x> ≺ P'' ∧ P''[x::=u] ⟹⇩τ P'"
proof -
assume "P ⟹⇩lα ≺ P'"
thus ?thesis1 by(auto simp add: transition_def residual.inject)
next
assume "P ⟹⇩la<νx> ≺ P'" and "x ♯ P"
thus "∃P'' P'''. P ⟹⇩τ P''' ∧ P''' ⟼a<νx> ≺ P'' ∧ P'' ⟹⇩τ P'"
using [[hypsubst_thin = true]]
apply(auto simp add: transition_def residualInject name_abs_eq)
apply(rule_tac x="[(x, y)] ∙ P''" in exI)
apply(rule_tac x=P' in exI)
apply(clarsimp)
apply(auto)
apply(subgoal_tac "x ♯ P''")
apply(simp add: alphaBoundResidual name_swap)
using freshChain
apply(force dest: freshBoundDerivative)
using eqvtChainI
by simp
next
assume PTrans: "P ⟹⇩lu in P''→a<x> ≺ P'"
thus "∃P'''. P ⟹⇩τ P''' ∧ P''' ⟼ a<x> ≺ P'' ∧ P''[x::=u] ⟹⇩τ P'"
by(auto simp add: inputTransition_def)
qed
lemma alphaInput:
fixes P :: pi
and u :: name
and P'' :: pi
and a :: name
and x :: name
and P' :: pi
and y :: name
assumes PTrans: "P ⟹⇩lu in P''→a<x> ≺ P'"
and yFreshP: "y ♯ P"
shows "P ⟹⇩lu in ([(x, y)] ∙ P'')→a<y> ≺ P'"
proof(cases "x=y")
assume "x=y"
with PTrans show ?thesis by simp
next
assume xineqy: "x≠y"
from PTrans obtain P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼a<x> ≺ P''"
and P''Chain: "P''[x::=u] ⟹⇩τ P'"
by(blast dest: transitionE)
from PChain yFreshP have "y ♯ P'''" by(rule freshChain)
with P'''Trans xineqy have yFreshP'': "y ♯ P''" by(blast dest: freshBoundDerivative)
with P'''Trans have "P''' ⟼a<y> ≺ [(x, y)] ∙ P''" by(simp add: alphaBoundResidual)
moreover from P''Chain yFreshP'' have "([(x, y)] ∙ P'')[y::=u] ⟹⇩τ P'"
by(simp add: renaming name_swap)
ultimately show ?thesis using PChain by(blast intro: transitionI)
qed
lemma tauActionChain:
fixes P :: pi
and P' :: pi
shows "P ⟹⇩lτ ≺ P' ⟹ P ⟹⇩τ P'"
and "P ≠ P' ⟹ P ⟹⇩τ P' ⟹ P ⟹⇩lτ ≺ P'"
proof -
assume "P ⟹⇩lτ ≺ P'"
then obtain P'' P''' where "P ⟹⇩τ P''"
and "P'' ⟼τ ≺ P'''"
and "P''' ⟹⇩τ P'"
by(blast dest: transitionE)
thus "P ⟹⇩τ P'" by auto
next
assume "P ⟹⇩τ P'" and "P ≠ P'"
thus "P ⟹⇩lτ ≺ P'"
proof(induct rule: tauChainInduct)
case id
thus ?case by simp
next
case(ih P'' P''')
have "P ⟹⇩τ P''" and "P'' ⟼ τ ≺ P'''" by fact+
moreover have "P''' ⟹⇩τ P'''" by simp
ultimately show ?case by(rule transitionI)
qed
qed
lemma singleActionChain:
fixes P :: pi
and a :: name
and x :: name
and α :: freeRes
and u :: name
shows "P ⟼a<νx> ≺ P' ⟹ P ⟹⇩la<νx> ≺ P'"
and "⟦P ⟼a<x> ≺ P'⟧ ⟹ P ⟹⇩lu in P'→a<x> ≺ P'[x::=u]"
and "P ⟼α ≺ P' ⟹ P ⟹⇩lα ≺ P'"
proof -
assume "P ⟼a<νx> ≺ P'"
moreover have "P ⟹⇩τ P" by simp
moreover have "P' ⟹⇩τ P'" by simp
ultimately show "P ⟹⇩la<νx> ≺ P'" by(blast intro: transitionI)
next
assume "P ⟼a<x> ≺ P'"
moreover have "P ⟹⇩τ P" by simp
moreover have "P'[x::=u] ⟹⇩τ P'[x::=u]" by simp
ultimately show "P ⟹⇩lu in P'→a<x> ≺ P'[x::=u]" by(blast intro: transitionI)
next
assume "P ⟼α ≺ P'"
moreover have "P ⟹⇩τ P" by simp
moreover have "P' ⟹⇩τ P'" by simp
ultimately show "P ⟹⇩lα ≺ P'" by(blast intro: transitionI)
qed
lemma Tau:
fixes P :: pi
shows "τ.(P) ⟹⇩l τ ≺ P"
proof -
have "τ.(P) ⟹⇩τ τ.(P)" by simp
moreover have "τ.(P) ⟼τ ≺ P" by(rule transitions.Tau)
moreover have "P ⟹⇩τ P" by simp
ultimately show ?thesis by(rule transitionI)
qed
lemma Input:
fixes a :: name
and x :: name
and u :: name
and P :: pi
shows "a<x>.P ⟹⇩lu in P→a<x> ≺ P[x::=u]"
proof -
have "a<x>.P ⟹⇩τ a<x>.P" by simp
moreover have "a<x>.P ⟼ a<x> ≺ P" by(rule Input)
moreover have "P[x::=u] ⟹⇩τ P[x::=u]" by simp
ultimately show ?thesis by(rule transitionI)
qed
lemma Output:
fixes a :: name
and b :: name
and P :: pi
shows "a{b}.P ⟹⇩la[b] ≺ P"
proof -
have "a{b}.P ⟹⇩τ a{b}.P" by simp
moreover have "a{b}.P ⟼a[b] ≺ P" by(rule transitions.Output)
moreover have "P ⟹⇩τ P" by simp
ultimately show ?thesis by(rule transitionI)
qed
lemma Match:
fixes P :: pi
and Rs :: residual
and a :: name
and u :: name
and b :: name
and x :: name
and P' :: pi
shows "P ⟹⇩l Rs ⟹ [a⌢a]P ⟹⇩l Rs"
and "P ⟹⇩lu in P''→b<x> ≺ P' ⟹ [a⌢a]P ⟹⇩lu in P''→b<x> ≺ P'"
proof -
assume PTrans: "P ⟹⇩l Rs"
thus "[a⌢a]P ⟹⇩l Rs"
proof(nominal_induct avoiding: P rule: residual.strong_inducts)
case(BoundR b x P')
have PTrans: "P ⟹⇩l b«x» ≺ P'" and xFreshP: "x ♯ P" by fact+
from PTrans obtain b' where beq: "b = BoundOutputS b'" by(cases b) auto
with PTrans xFreshP obtain P'' P''' where PTrans: "P ⟹⇩τ P''"
and P''Trans: "P'' ⟼b'<νx> ≺ P'''"
and P'''Trans: "P''' ⟹⇩τ P'"
by(blast dest: transitionE)
show ?case
proof(cases "P = P''")
assume "P = P''"
moreover have "[a⌢a]P ⟹⇩τ [a⌢a]P" by simp
moreover from P''Trans have "[a⌢a]P'' ⟼ b'<νx> ≺ P'''" by(rule Match)
ultimately show ?thesis using beq P'''Trans by(blast intro: transitionI)
next
assume "P ≠ P''"
with PTrans have "[a⌢a]P ⟹⇩τ P''" by(rule matchChain)
thus ?thesis using beq P''Trans P'''Trans by(blast intro: transitionI)
qed
next
case(FreeR α P')
have "P ⟹⇩l α ≺ P'" by fact
then obtain P'' P''' where PTrans: "P ⟹⇩τ P''"
and P''Trans: "P'' ⟼ α ≺ P'''"
and P'''Trans: "P''' ⟹⇩τ P'"
by(blast dest: transitionE)
show ?case
proof(cases "P = P''")
assume "P = P''"
moreover have "[a⌢a]P ⟹⇩τ [a⌢a]P" by simp
moreover from P''Trans have "[a⌢a]P'' ⟼ α ≺ P'''" by(rule transitions.Match)
ultimately show ?thesis using P'''Trans by(blast intro: transitionI)
next
assume "P ≠ P''"
with PTrans have "[a⌢a]P ⟹⇩τ P''" by(rule matchChain)
thus ?thesis using P''Trans P'''Trans by(rule transitionI)
qed
qed
next
assume "P ⟹⇩lu in P''→b<x> ≺ P'"
then obtain P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼b<x> ≺ P''"
and P''Chain: "P''[x::=u] ⟹⇩τ P'"
by(blast dest: transitionE)
show "[a⌢a]P ⟹⇩lu in P''→b<x> ≺ P'"
proof(cases "P=P'''")
assume "P=P'''"
moreover have "[a⌢a]P ⟹⇩τ [a⌢a]P" by simp
moreover from P'''Trans have "[a⌢a]P''' ⟼b<x> ≺ P''" by(rule Late_Semantics.Match)
ultimately show ?thesis using P''Chain by(blast intro: transitionI)
next
assume "P ≠ P'''"
with PChain have "[a⌢a]P ⟹⇩τ P'''" by(rule matchChain)
thus ?thesis using P'''Trans P''Chain by(rule transitionI)
qed
qed
lemma Mismatch:
fixes P :: pi
and Rs :: residual
and a :: name
and c :: name
and u :: name
and b :: name
and x :: name
and P' :: pi
shows "⟦P ⟹⇩l Rs; a ≠ c⟧ ⟹ [a≠c]P ⟹⇩l Rs"
and "⟦P ⟹⇩lu in P''→b<x> ≺ P'; a ≠ c⟧ ⟹ [a≠c]P ⟹⇩lu in P''→b<x> ≺ P'"
proof -
assume PTrans: "P ⟹⇩l Rs"
and aineqc: "a ≠ c"
thus "[a≠c]P ⟹⇩l Rs"
proof(nominal_induct avoiding: P rule: residual.strong_inducts)
case(BoundR b x P')
have PTrans: "P ⟹⇩l b«x» ≺ P'" and xFreshP: "x ♯ P" by fact+
from PTrans obtain b' where beq: "b = BoundOutputS b'" by(cases b, auto)
with PTrans xFreshP obtain P'' P''' where PTrans: "P ⟹⇩τ P''"
and P''Trans: "P'' ⟼b'<νx> ≺ P'''"
and P'''Trans: "P''' ⟹⇩τ P'"
by(blast dest: transitionE)
show ?case
proof(cases "P = P''")
assume "P = P''"
moreover have "[a≠c]P ⟹⇩τ [a≠c]P" by simp
moreover from P''Trans aineqc have "[a≠c]P'' ⟼b'<νx> ≺ P'''" by(rule transitions.Mismatch)
ultimately show ?thesis using beq P'''Trans by(blast intro: transitionI)
next
assume "P ≠ P''"
with PTrans aineqc have "[a≠c]P ⟹⇩τ P''" by(rule mismatchChain)
thus ?thesis using beq P''Trans P'''Trans by(blast intro: transitionI)
qed
next
case(FreeR α P')
have "P ⟹⇩l α ≺ P'" by fact
then obtain P'' P''' where PTrans: "P ⟹⇩τ P''"
and P''Trans: "P'' ⟼ α ≺ P'''"
and P'''Trans: "P''' ⟹⇩τ P'"
by(blast dest: transitionE)
show ?case
proof(cases "P = P''")
assume "P = P''"
moreover have "[a≠c]P ⟹⇩τ [a≠c]P" by simp
moreover from P''Trans ‹a ≠ c› have "[a≠c]P'' ⟼ α ≺ P'''" by(rule transitions.Mismatch)
ultimately show ?thesis using P'''Trans by(blast intro: transitionI)
next
assume "P ≠ P''"
with PTrans aineqc have "[a≠c]P ⟹⇩τ P''" by(rule mismatchChain)
thus ?thesis using P''Trans P'''Trans by(rule transitionI)
qed
qed
next
assume aineqc: "a ≠ c"
assume "P ⟹⇩lu in P''→b<x> ≺ P'"
then obtain P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼b<x> ≺ P''"
and P''Chain: "P''[x::=u] ⟹⇩τ P'"
by(blast dest: transitionE)
show "[a≠c]P ⟹⇩lu in P''→b<x> ≺ P'"
proof(cases "P=P'''")
assume "P=P'''"
moreover have "[a≠c]P ⟹⇩τ [a≠c]P" by simp
moreover from P'''Trans aineqc have "[a≠c]P''' ⟼b<x> ≺ P''" by(rule Late_Semantics.Mismatch)
ultimately show ?thesis using P''Chain by(blast intro: transitionI)
next
assume "P ≠ P'''"
with PChain aineqc have "[a≠c]P ⟹⇩τ P'''" by(rule mismatchChain)
thus ?thesis using P'''Trans P''Chain by(rule transitionI)
qed
qed
lemma Open:
fixes P :: pi
and a :: name
and b :: name
and P' :: pi
assumes Trans: "P ⟹⇩la[b] ≺ P'"
and aInEqb: "a ≠ b"
shows "<νb>P ⟹⇩la<νb> ≺ P'"
proof -
from Trans obtain P'' P''' where A: "P ⟹⇩τ P''"
and B: "P'' ⟼a[b] ≺ P'''"
and C: "P''' ⟹⇩τ P'"
by(force dest: transitionE)
from A have "<νb>P ⟹⇩τ <νb>P''" by(rule ResChain)
moreover from B aInEqb have "<νb>P'' ⟼a<νb> ≺ P'''" by(rule Open)
ultimately show ?thesis using C by(force simp add: transition_def)
qed
lemma Sum1:
fixes P :: pi
and Rs :: residual
and Q :: pi
and u :: name
and P'' :: pi
and a :: name
and x :: name
and P' :: pi
shows "P ⟹⇩l Rs ⟹ P ⊕ Q ⟹⇩l Rs"
and "P ⟹⇩lu in P''→a<x> ≺ P' ⟹ P ⊕ Q ⟹⇩lu in P''→a<x> ≺ P'"
proof -
assume "P ⟹⇩l Rs"
thus "P ⊕ Q ⟹⇩l Rs"
proof(nominal_induct avoiding: P rule: residual.strong_inducts)
case(BoundR a x P' P)
have PTrans: "P ⟹⇩la«x» ≺ P'"
and xFreshP: "x ♯ P" by fact+
from PTrans obtain a' where aeq: "a = BoundOutputS a'" by(cases a, auto)
with PTrans xFreshP obtain P'' P''' where PTrans: "P ⟹⇩τ P''"
and P''Trans: "P'' ⟼a'<νx> ≺ P'''"
and P'''Trans: "P''' ⟹⇩τ P'"
by(blast dest: transitionE)
show ?case
proof(cases "P = P''")
assume "P = P''"
moreover have "P ⊕ Q ⟹⇩τ P ⊕ Q" by simp
moreover from P''Trans have "P'' ⊕ Q ⟼a'<νx> ≺ P'''" by(rule transitions.Sum1)
ultimately show ?thesis using P'''Trans aeq by(blast intro: transitionI)
next
assume "P ≠ P''"
with PTrans have "P ⊕ Q ⟹⇩τ P''" by(rule sum1Chain)
thus ?thesis using P''Trans P'''Trans aeq by(blast intro: transitionI)
qed
next
case(FreeR α P')
have "P ⟹⇩l α ≺ P'" by fact
then obtain P'' P''' where PTrans: "P ⟹⇩τ P''"
and P''Trans: "P'' ⟼ α ≺ P'''"
and P'''Trans: "P''' ⟹⇩τ P'"
by(blast dest: transitionE)
show ?case
proof(cases "P = P''")
assume "P = P''"
moreover have "P ⊕ Q ⟹⇩τ P ⊕ Q" by simp
moreover from P''Trans have "P'' ⊕ Q ⟼ α ≺ P'''" by(rule transitions.Sum1)
ultimately show ?thesis using P'''Trans by(blast intro: transitionI)
next
assume "P ≠ P''"
with PTrans have "P ⊕ Q ⟹⇩τ P''" by(rule sum1Chain)
thus ?thesis using P''Trans P'''Trans by(rule transitionI)
qed
qed
next
assume "P ⟹⇩lu in P''→a<x> ≺ P'"
then obtain P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼a<x> ≺ P''"
and P''Chain: "P''[x::=u] ⟹⇩τ P'"
by(blast dest: transitionE)
show "P ⊕ Q ⟹⇩lu in P''→a<x> ≺ P'"
proof(cases "P = P'''")
assume "P = P'''"
moreover have "P ⊕ Q ⟹⇩τ P ⊕ Q" by simp
moreover from P'''Trans have "P''' ⊕ Q ⟼a<x> ≺ P''" by(rule transitions.Sum1)
ultimately show ?thesis using P''Chain by(blast intro: transitionI)
next
assume "P ≠ P'''"
with PChain have "P ⊕ Q ⟹⇩τ P'''" by(rule sum1Chain)
thus ?thesis using P'''Trans P''Chain by(blast intro: transitionI)
qed
qed
lemma Sum2:
fixes Q :: pi
and Rs :: residual
and P :: pi
and u :: name
and Q'' :: pi
and a :: name
and x :: name
and Q' :: pi
shows "Q ⟹⇩l Rs ⟹ P ⊕ Q ⟹⇩l Rs"
and "Q ⟹⇩lu in Q''→a<x> ≺ Q' ⟹ P ⊕ Q ⟹⇩lu in Q''→a<x> ≺ Q'"
proof -
assume "Q ⟹⇩l Rs"
thus "P ⊕ Q ⟹⇩l Rs"
proof(nominal_induct avoiding: Q rule: residual.strong_inducts)
case(BoundR a x Q' Q)
have QTrans: "Q ⟹⇩la«x» ≺ Q'"
and xFreshQ: "x ♯ Q" by fact+
from QTrans obtain a' where aeq: "a = BoundOutputS a'" by(cases a, auto)
with QTrans xFreshQ obtain Q'' Q''' where QTrans: "Q ⟹⇩τ Q''"
and Q''Trans: "Q'' ⟼a'<νx> ≺ Q'''"
and Q'''Trans: "Q''' ⟹⇩τ Q'"
by(blast dest: transitionE)
show ?case
proof(cases "Q = Q''")
assume "Q = Q''"
moreover have "P ⊕ Q ⟹⇩τ P ⊕ Q" by simp
moreover from Q''Trans have "P ⊕ Q'' ⟼a'<νx> ≺ Q'''" by(rule transitions.Sum2)
ultimately show ?thesis using Q'''Trans aeq by(blast intro: transitionI)
next
assume "Q ≠ Q''"
with QTrans have "P ⊕ Q ⟹⇩τ Q''" by(rule sum2Chain)
thus ?thesis using Q''Trans Q'''Trans aeq by(blast intro: transitionI)
qed
next
case(FreeR α Q')
have "Q ⟹⇩l α ≺ Q'" by fact
then obtain Q'' Q''' where QTrans: "Q ⟹⇩τ Q''"
and Q''Trans: "Q'' ⟼ α ≺ Q'''"
and Q'''Trans: "Q''' ⟹⇩τ Q'"
by(blast dest: transitionE)
show ?case
proof(cases "Q = Q''")
assume "Q = Q''"
moreover have "P ⊕ Q ⟹⇩τ P ⊕ Q" by simp
moreover from Q''Trans have "P ⊕ Q'' ⟼ α ≺ Q'''" by(rule transitions.Sum2)
ultimately show ?thesis using Q'''Trans by(blast intro: transitionI)
next
assume "Q ≠ Q''"
with QTrans have "P ⊕ Q ⟹⇩τ Q''" by(rule sum2Chain)
thus ?thesis using Q''Trans Q'''Trans by(rule transitionI)
qed
qed
next
assume "Q ⟹⇩lu in Q''→a<x> ≺ Q'"
then obtain Q''' where QChain: "Q ⟹⇩τ Q'''"
and Q'''Trans: "Q''' ⟼a<x> ≺ Q''"
and Q''Chain: "Q''[x::=u] ⟹⇩τ Q'"
by(blast dest: transitionE)
show "P ⊕ Q ⟹⇩lu in Q''→a<x> ≺ Q'"
proof(cases "Q = Q'''")
assume "Q = Q'''"
moreover have "P ⊕ Q ⟹⇩τ P ⊕ Q" by simp
moreover from Q'''Trans have "P ⊕ Q''' ⟼a<x> ≺ Q''" by(rule transitions.Sum2)
ultimately show ?thesis using Q''Chain by(blast intro: transitionI)
next
assume "Q ≠ Q'''"
with QChain have "P ⊕ Q ⟹⇩τ Q'''" by(rule sum2Chain)
thus ?thesis using Q'''Trans Q''Chain by(blast intro: transitionI)
qed
qed
lemma Par1B:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
and u :: name
and P'' :: pi
shows "⟦P ⟹⇩la<νx> ≺ P'; x ♯ Q⟧ ⟹ P ∥ Q ⟹⇩la<νx> ≺ (P' ∥ Q)"
and "⟦P ⟹⇩lu in P''→a<x> ≺ P'; x ♯ Q⟧ ⟹ P ∥ Q ⟹⇩lu in (P'' ∥ Q)→a<x> ≺ P' ∥ Q"
proof -
assume PTrans: "P ⟹⇩l a<νx> ≺ P'"
assume xFreshQ: "x ♯ Q"
have Goal: "⋀P a x P' Q. ⟦P ⟹⇩la<νx> ≺ P'; x ♯ P; x ♯ Q⟧ ⟹ P ∥ Q ⟹⇩la<νx> ≺ (P' ∥ Q)"
proof -
fix P a x P' Q
assume PTrans: "P ⟹⇩la<νx> ≺ P'"
assume xFreshP: "x ♯ P"
assume xFreshQ: "x ♯ (Q::pi)"
from PTrans xFreshP obtain P'' P''' where PTrans: "P ⟹⇩τ P''"
and P''Trans: "P'' ⟼a<νx> ≺ P'''"
and P'''Trans: "P''' ⟹⇩τ P'"
by(blast dest: transitionE)
from PTrans have "P ∥ Q ⟹⇩τ P'' ∥ Q" by(rule Par1Chain)
moreover from P''Trans xFreshQ have "P'' ∥ Q ⟼a<νx> ≺ (P''' ∥ Q)" by(rule Par1B)
moreover from P'''Trans have "P''' ∥ Q ⟹⇩τ P' ∥ Q" by(rule Par1Chain)
ultimately show "P ∥ Q ⟹⇩la<νx> ≺ (P' ∥ Q)" by(rule transitionI)
qed
have "∃c::name. c ♯ (P, P', Q)" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshP: "c ♯ P" and cFreshP': "c ♯ P'" and cFreshQ: "c ♯ Q"
by(force simp add: fresh_prod)
from cFreshP' have "a<νx> ≺ P' = a<νc> ≺ ([(x, c)] ∙ P')" by(rule alphaBoundResidual)
moreover have "a<νx> ≺ (P' ∥ Q) = a<νc> ≺ (([(x, c)] ∙ P') ∥ Q)"
proof -
from cFreshP' cFreshQ have "c ♯ P' ∥ Q" by simp
hence "a<νx> ≺ (P' ∥ Q) = a<νc> ≺ ([(x, c)] ∙ (P' ∥ Q))" by(rule alphaBoundResidual)
with cFreshQ xFreshQ show ?thesis by(simp add: name_fresh_fresh)
qed
ultimately show "P ∥ Q ⟹⇩l a<νx> ≺ P' ∥ Q" using PTrans cFreshP cFreshQ by(force intro: Goal)
next
assume PTrans: "P ⟹⇩lu in P''→a<x> ≺ P'"
and xFreshQ: "x ♯ Q"
from PTrans obtain P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼a<x> ≺ P''"
and P''Chain: "P''[x::=u] ⟹⇩τ P'"
by(blast dest: transitionE)
from PChain have "P ∥ Q ⟹⇩τ P''' ∥ Q" by(rule Par1Chain)
moreover from P'''Trans xFreshQ have "P''' ∥ Q ⟼a<x> ≺ (P'' ∥ Q)" by(rule Par1B)
moreover have "(P'' ∥ Q)[x::=u] ⟹⇩τ P' ∥ Q"
proof -
from P''Chain have "P''[x::=u] ∥ Q ⟹⇩τ P' ∥ Q" by(rule Par1Chain)
with xFreshQ show ?thesis by(simp add: forget)
qed
ultimately show "P ∥ Q ⟹⇩lu in (P'' ∥ Q)→a<x> ≺ (P' ∥ Q)" by(rule transitionI)
qed
lemma Par1F:
fixes P :: pi
and α :: freeRes
and P' :: pi
assumes PTrans: "P ⟹⇩lα ≺ P'"
shows "P ∥ Q ⟹⇩lα ≺ (P' ∥ Q)"
proof -
from PTrans obtain P'' P''' where PTrans: "P ⟹⇩τ P''"
and P''Trans: "P'' ⟼α ≺ P'''"
and P'''Trans: "P''' ⟹⇩τ P'"
by(blast dest: transitionE)
from PTrans have "P ∥ Q ⟹⇩τ P'' ∥ Q" by(rule Par1Chain)
moreover from P''Trans have "P'' ∥ Q ⟼α ≺ (P''' ∥ Q)" by(rule transitions.Par1F)
moreover from P'''Trans have "P''' ∥ Q ⟹⇩τ P' ∥ Q" by(rule Par1Chain)
ultimately show ?thesis by(rule transitionI)
qed
lemma Par2B:
fixes Q :: pi
and a :: name
and x :: name
and Q' :: pi
and P :: pi
and u :: name
and Q'' :: pi
shows "Q ⟹⇩la<νx> ≺ Q' ⟹ x ♯ P ⟹ P ∥ Q ⟹⇩la<νx> ≺ (P ∥ Q')"
and "Q ⟹⇩lu in Q''→a<x> ≺ Q' ⟹ x ♯ P ⟹ P ∥ Q ⟹⇩lu in (P ∥ Q'')→a<x> ≺ P ∥ Q'"
proof -
assume QTrans: "Q ⟹⇩l a<νx> ≺ Q'"
assume xFreshP: "x ♯ P"
have Goal: "⋀Q a x Q' P. ⟦Q ⟹⇩la<νx> ≺ Q'; x ♯ Q; x ♯ P⟧ ⟹ P ∥ Q ⟹⇩la<νx> ≺ (P ∥ Q')"
proof -
fix Q a x Q' P
assume QTrans: "Q ⟹⇩la<νx> ≺ Q'"
assume xFreshQ: "x ♯ Q"
assume xFreshP: "x ♯ (P::pi)"
from QTrans xFreshQ obtain Q'' Q''' where QTrans: "Q ⟹⇩τ Q''"
and Q''Trans: "Q'' ⟼a<νx> ≺ Q'''"
and Q'''Trans: "Q''' ⟹⇩τ Q'"
by(blast dest: transitionE)
from QTrans have "P ∥ Q ⟹⇩τ P ∥ Q''" by(rule Par2Chain)
moreover from Q''Trans xFreshP have "P ∥ Q'' ⟼a<νx> ≺ (P ∥ Q''')" by(rule Par2B)
moreover from Q'''Trans have "P ∥ Q''' ⟹⇩τ P ∥ Q'" by(rule Par2Chain)
ultimately show "P ∥ Q ⟹⇩la<νx> ≺ (P ∥ Q')" by(rule transitionI)
qed
have "∃c::name. c ♯ (Q, Q', P)" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshQ: "c ♯ Q" and cFreshQ': "c ♯ Q'" and cFreshP: "c ♯ P"
by(force simp add: fresh_prod)
from cFreshQ' have "a<νx> ≺ Q' = a<νc> ≺ ([(x, c)] ∙ Q')" by(rule alphaBoundResidual)
moreover have "a<νx> ≺ (P ∥ Q') = a<νc> ≺ (P ∥ ([(x, c)] ∙ Q'))"
proof -
from cFreshQ' cFreshP have "c ♯ P ∥ Q'" by simp
hence "a<νx> ≺ (P ∥ Q') = a<νc> ≺ ([(x, c)] ∙ (P ∥ Q'))" by(rule alphaBoundResidual)
with cFreshP xFreshP show ?thesis by(simp add: name_fresh_fresh)
qed
ultimately show "P ∥ Q ⟹⇩l a<νx> ≺ P ∥ Q'" using QTrans cFreshQ cFreshP by(force intro: Goal)
next
assume QTrans: "Q ⟹⇩lu in Q''→a<x> ≺ Q'"
and xFreshP: "x ♯ P"
from QTrans obtain Q''' where QChain: "Q ⟹⇩τ Q'''"
and Q'''Trans: "Q''' ⟼a<x> ≺ Q''"
and Q''Chain: "Q''[x::=u] ⟹⇩τ Q'"
by(blast dest: transitionE)
from QChain have "P ∥ Q ⟹⇩τ P ∥ Q'''" by(rule Par2Chain)
moreover from Q'''Trans xFreshP have "P ∥ Q''' ⟼a<x> ≺ (P ∥ Q'')" by(rule Par2B)
moreover have "(P ∥ Q'')[x::=u] ⟹⇩τ P ∥ Q'"
proof -
from Q''Chain have "P ∥ (Q''[x::=u]) ⟹⇩τ P ∥ Q'" by(rule Par2Chain)
with xFreshP show ?thesis by(simp add: forget)
qed
ultimately show "P ∥ Q ⟹⇩lu in (P ∥ Q'')→a<x> ≺ (P ∥ Q')" by(rule transitionI)
qed
lemma Par2F:
fixes Q :: pi
and α :: freeRes
and Q' :: pi
assumes QTrans: "Q ⟹⇩lα ≺ Q'"
shows "P ∥ Q ⟹⇩lα ≺ (P ∥ Q')"
proof -
from QTrans obtain Q'' Q''' where QTrans: "Q ⟹⇩τ Q''"
and Q''Trans: "Q'' ⟼α ≺ Q'''"
and Q'''Trans: "Q''' ⟹⇩τ Q'"
by(blast dest: transitionE)
from QTrans have "P ∥ Q ⟹⇩τ P ∥ Q''" by(rule Par2Chain)
moreover from Q''Trans have "P ∥ Q'' ⟼α ≺ (P ∥ Q''')" by(rule transitions.Par2F)
moreover from Q'''Trans have "P ∥ Q''' ⟹⇩τ P ∥ Q'" by(rule Par2Chain)
ultimately show ?thesis by(rule transitionI)
qed
lemma Comm1:
fixes P :: pi
and b :: name
and P'' :: pi
and a :: name
and x :: name
and P' :: pi
and Q :: pi
and Q' :: pi
assumes PTrans: "P ⟹⇩lb in P'' →a<x> ≺ P'"
and QTrans: "Q ⟹⇩la[b] ≺ Q'"
shows "P ∥ Q ⟹⇩lτ ≺ P' ∥ Q'"
proof -
from PTrans obtain P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼a<x> ≺ P''"
and P''Chain: "P''[x::=b] ⟹⇩τ P'"
by(blast dest: transitionE)
from QTrans obtain Q'' Q''' where QChain: "Q ⟹⇩τ Q'''"
and Q'''Trans: "Q''' ⟼a[b] ≺ Q''"
and Q''Chain: "Q'' ⟹⇩τ Q'"
by(blast dest: transitionE)
from PChain QChain have "P ∥ Q ⟹⇩τ P''' ∥ Q'''" by(rule chainPar)
moreover from P'''Trans Q'''Trans have "P''' ∥ Q''' ⟼τ ≺ P''[x::=b] ∥ Q''"
by(rule Comm1)
moreover from P''Chain Q''Chain have "P''[x::=b] ∥ Q'' ⟹⇩τ P' ∥ Q'" by(rule chainPar)
ultimately show ?thesis by(rule transitionI)
qed
lemma Comm2:
fixes P :: pi
and a :: name
and b :: name
and P' :: pi
and Q :: pi
and x :: name
and Q'' :: pi
and Q' :: pi
assumes PTrans: "P ⟹⇩la[b] ≺ P'"
and QTrans: "Q ⟹⇩lb in Q''→a<x> ≺ Q'"
shows "P ∥ Q ⟹⇩lτ ≺ P' ∥ Q'"
proof -
from PTrans obtain P'' P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼a[b] ≺ P''"
and P''Chain: "P'' ⟹⇩τ P'"
by(blast dest: transitionE)
from QTrans obtain Q''' where QChain: "Q ⟹⇩τ Q'''"
and Q'''Trans: "Q''' ⟼a<x> ≺ Q''"
and Q''Chain: "Q''[x::=b] ⟹⇩τ Q'"
by(blast dest: transitionE)
from PChain QChain have "P ∥ Q ⟹⇩τ P''' ∥ Q'''" by(rule chainPar)
moreover from P'''Trans Q'''Trans have "P''' ∥ Q''' ⟼τ ≺ P'' ∥ (Q''[x::=b])"
by(rule Comm2)
moreover from P''Chain Q''Chain have "P'' ∥ (Q''[x::=b]) ⟹⇩τ P' ∥ Q'" by(rule chainPar)
ultimately show ?thesis by(rule transitionI)
qed
lemma Close1:
fixes P :: pi
and y :: name
and P'' :: pi
and a :: name
and x :: name
and P' :: pi
and Q :: pi
and Q' :: pi
assumes PTrans: "P ⟹⇩ly in P''→a<x> ≺ P'"
and QTrans: "Q ⟹⇩la<νy> ≺ Q'"
and yFreshP: "y ♯ P"
and yFreshQ: "y ♯ Q"
shows "P ∥ Q ⟹⇩lτ ≺ <νy>(P' ∥ Q')"
proof -
from PTrans obtain P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼a<x> ≺ P''"
and P''Chain: "P''[x::=y] ⟹⇩τ P'"
by(blast dest: transitionE)
from QTrans yFreshQ obtain Q'' Q''' where QChain: "Q ⟹⇩τ Q'''"
and Q'''Trans: "Q''' ⟼a<νy> ≺ Q''"
and Q''Chain: "Q'' ⟹⇩τ Q'"
by(blast dest: transitionE)
from PChain yFreshP have yFreshP''': "y ♯ P'''" by(rule freshChain)
from PChain QChain have "P ∥ Q ⟹⇩τ P''' ∥ Q'''" by(rule chainPar)
moreover from P'''Trans Q'''Trans yFreshP''' have "P''' ∥ Q''' ⟼τ ≺ <νy>(P''[x::=y] ∥ Q'')"
by(rule Close1)
moreover have "<νy>(P''[x::=y] ∥ Q'') ⟹⇩τ <νy>(P' ∥ Q')"
proof -
from P''Chain Q''Chain have "P''[x::=y] ∥ Q'' ⟹⇩τ P' ∥ Q'" by(rule chainPar)
thus ?thesis by(rule ResChain)
qed
ultimately show "P ∥ Q ⟹⇩lτ ≺ <νy>(P' ∥ Q')" by(rule transitionI)
qed
lemma Close2:
fixes P :: pi
and y :: name
and a :: name
and x :: name
and P' :: pi
and Q :: pi
and Q'' :: pi
and Q' :: pi
assumes PTrans: "P ⟹⇩la<νy> ≺ P'"
and QTrans: "Q ⟹⇩ly in Q''→a<x> ≺ Q'"
and yFreshP: "y ♯ P"
and yFreshQ: "y ♯ Q"
shows "P ∥ Q ⟹⇩lτ ≺ <νy>(P' ∥ Q')"
proof -
from PTrans yFreshP obtain P'' P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼a<νy> ≺ P''"
and P''Chain: "P'' ⟹⇩τ P'"
by(blast dest: transitionE)
from QTrans obtain Q''' where QChain: "Q ⟹⇩τ Q'''"
and Q'''Trans: "Q''' ⟼a<x> ≺ Q''"
and Q''Chain: "Q''[x::=y] ⟹⇩τ Q'"
by(blast dest: transitionE)
from QChain yFreshQ have yFreshQ''': "y ♯ Q'''" by(rule freshChain)
from PChain QChain have "P ∥ Q ⟹⇩τ P''' ∥ Q'''" by(rule chainPar)
moreover from P'''Trans Q'''Trans yFreshQ''' have "P''' ∥ Q''' ⟼τ ≺ <νy>(P'' ∥ (Q''[x::=y]))"
by(rule Close2)
moreover have "<νy>(P'' ∥ (Q''[x::=y])) ⟹⇩τ <νy>(P' ∥ Q')"
proof -
from P''Chain Q''Chain have "P'' ∥ (Q''[x::=y]) ⟹⇩τ P' ∥ Q'" by(rule chainPar)
thus ?thesis by(rule ResChain)
qed
ultimately show "P ∥ Q ⟹⇩lτ ≺ <νy>(P' ∥ Q')" by(rule transitionI)
qed
lemma ResF:
fixes P :: pi
and α :: freeRes
and P' :: pi
and x :: name
assumes PTrans: "P ⟹⇩lα ≺ P'"
and xFreshAlpha: "x ♯ α"
shows "<νx>P ⟹⇩lα ≺ <νx>P'"
proof -
from PTrans obtain P'' P''' where PChain: "P ⟹⇩τ P''"
and P''Trans: "P'' ⟼α ≺ P'''"
and P'''Chain: "P''' ⟹⇩τ P'"
by(blast dest: transitionE)
from PChain have "<νx>P ⟹⇩τ <νx>P''" by(rule ResChain)
moreover from P''Trans xFreshAlpha have "<νx>P'' ⟼α ≺ <νx>P'''"
by(rule transitions.ResF)
moreover from P'''Chain have "<νx>P''' ⟹⇩τ <νx>P'" by(rule ResChain)
ultimately show ?thesis by(rule transitionI)
qed
lemma ResB:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
and y :: name
and u :: name
and P'' :: pi
shows "⟦P ⟹⇩la<νx> ≺ P'; y ≠ a; y ≠ x; x ♯ P⟧ ⟹ <νy>P ⟹⇩la<νx> ≺ (<νy>P')"
and "⟦P ⟹⇩lu in P''→a<x> ≺ P'; y ≠ a; y ≠ x; y ≠ u⟧ ⟹ <νy>P ⟹⇩lu in (<νy>P'')→a<x> ≺ (<νy>P')"
proof -
assume PTrans: "P ⟹⇩la<νx> ≺ P'"
and yineqa: "y ≠ a"
and yineqx: "y ≠ x"
and xFreshP: "x ♯ P"
from PTrans xFreshP obtain P'' P''' where PChain: "P ⟹⇩τ P''"
and P''Trans: "P'' ⟼a<νx> ≺ P'''"
and P'''Chain: "P''' ⟹⇩τ P'"
by(blast dest: transitionE)
from PChain have "<νy>P ⟹⇩τ <νy>P''" by(rule ResChain)
moreover from P''Trans yineqa yineqx have "<νy>P'' ⟼a<νx> ≺ (<νy>P''')"
by(force intro: ResB)
moreover from P'''Chain have "<νy>P''' ⟹⇩τ <νy>P'" by(rule ResChain)
ultimately show "<νy>P ⟹⇩l a<νx> ≺ <νy>P'" by(rule transitionI)
next
assume PTrans: "P ⟹⇩lu in P''→a<x> ≺ P'"
and yineqa: "y ≠ a"
and yineqx: "y ≠ x"
and yinequ: "y ≠ u"
from PTrans obtain P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼a<x> ≺ P''"
and P''Chain: "P''[x::=u] ⟹⇩τ P'"
by(blast dest: transitionE)
from PChain have "<νy>P ⟹⇩τ <νy>P'''" by(rule ResChain)
moreover from P'''Trans yineqa yineqx have "<νy>P''' ⟼a<x> ≺ (<νy>P'')"
by(force intro: ResB)
moreover have "(<νy>P'')[x::=u] ⟹⇩τ <νy>P'"
proof -
from P''Chain have "<νy>(P''[x::=u]) ⟹⇩τ <νy>P'" by(rule ResChain)
with yineqx yinequ show ?thesis by(simp add: eqvt_subs[THEN sym])
qed
ultimately show "<νy>P ⟹⇩lu in (<νy>P'')→a<x> ≺ <νy>P'" by(rule transitionI)
qed
lemma Bang:
fixes P :: pi
and Rs :: residual
and u :: name
and P'' :: pi
and a :: name
and x :: name
and P' :: pi
shows "P ∥ !P ⟹⇩l Rs ⟹ !P ⟹⇩l Rs"
and "P ∥ !P ⟹⇩lu in P''→a<x> ≺ P' ⟹ !P ⟹⇩lu in P''→a<x> ≺ P'"
proof -
assume "P ∥ !P ⟹⇩l Rs"
thus "!P ⟹⇩l Rs"
proof(nominal_induct avoiding: P rule: residual.strong_inducts)
case(BoundR a x P' P)
assume xFreshP: "x ♯ P"
assume PTrans: "P ∥ !P ⟹⇩la«x» ≺ P'"
from PTrans obtain a' where aeq: "a = BoundOutputS a'" by(cases a, auto)
with PTrans xFreshP obtain P'' P''' where PChain: "P ∥ !P ⟹⇩τ P''"
and P''Trans: "P'' ⟼a'<νx> ≺ P'''"
and P'''Chain: "P''' ⟹⇩τ P'"
by(force dest: transitionE)
show "!P ⟹⇩la«x» ≺ P'"
proof(cases "P'' = P ∥ !P")
assume "P'' = P ∥ !P"
moreover with P''Trans have "!P ⟼a'<νx> ≺ P'''" by(blast intro: transitions.Bang)
ultimately show ?thesis using PChain P'''Chain aeq by(simp, rule_tac transitionI, auto)
next
assume "P'' ≠ P ∥ !P"
with PChain have "!P ⟹⇩τ P''" by(rule bangChain)
with P''Trans P'''Chain aeq show ?thesis by(blast intro: transitionI)
qed
next
fix α P' P
assume "P ∥ !P ⟹⇩lα ≺ P'"
then obtain P'' P''' where PChain: "P ∥ !P ⟹⇩τ P''"
and P''Trans: "P'' ⟼α ≺ P'''"
and P'''Chain: "P''' ⟹⇩τ P'"
by(force dest: transitionE)
show "!P ⟹⇩lα ≺ P'"
proof(cases "P'' = P ∥ !P")
assume "P'' = P ∥ !P"
moreover with P''Trans have "!P ⟼α ≺ P'''" by(blast intro: transitions.Bang)
ultimately show ?thesis using PChain P'''Chain by(rule_tac transitionI, auto)
next
assume "P'' ≠ P ∥ !P"
with PChain have "!P ⟹⇩τ P''" by(rule bangChain)
with P''Trans P'''Chain show ?thesis by(blast intro: transitionI)
qed
qed
next
assume "P ∥ !P ⟹⇩lu in P''→a<x> ≺ P'"
then obtain P''' where PChain: "P ∥ !P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼a<x> ≺ P''"
and P''Chain: "P''[x::=u] ⟹⇩τ P'"
by(force dest: transitionE)
show "!P ⟹⇩lu in P''→a<x> ≺ P'"
proof(cases "P''' = P ∥ !P")
assume "P''' = P ∥ !P"
moreover with P'''Trans have "!P ⟼a<x> ≺ P''" by(blast intro: transitions.Bang)
ultimately show ?thesis using PChain P''Chain by(rule_tac transitionI, auto)
next
assume "P''' ≠ P ∥ !P"
with PChain have "!P ⟹⇩τ P'''" by(rule bangChain)
with P'''Trans P''Chain show ?thesis by(blast intro: transitionI)
qed
qed
lemma tauTransitionChain:
fixes P :: pi
and P' :: pi
assumes "P ⟹⇩lτ ≺ P'"
shows "P ⟹⇩τ P'"
using assms
by(auto simp add: transition_def residualInject)
lemma chainTransitionAppend:
fixes P :: pi
and P' :: pi
and Rs :: residual
and a :: name
and x :: name
and P'' :: pi
and u :: name
and P''' :: pi
and α :: freeRes
shows "P ⟹⇩τ P' ⟹ P' ⟹⇩l Rs ⟹ P ⟹⇩l Rs"
and "P ⟹⇩τ P'' ⟹ P'' ⟹⇩lu in P'''→a<x> ≺ P' ⟹ P ⟹⇩lu in P'''→a<x> ≺ P'"
and "P ⟹⇩la<νx> ≺ P'' ⟹ P'' ⟹⇩τ P' ⟹ x ♯ P ⟹ P ⟹⇩la<νx> ≺ P'"
and "P ⟹⇩lu in P'''→a<x> ≺ P'' ⟹ P'' ⟹⇩τ P' ⟹ P ⟹⇩lu in P'''→a<x> ≺ P'"
and "P ⟹⇩lα ≺ P'' ⟹ P'' ⟹⇩τ P' ⟹ P ⟹⇩lα ≺ P'"
proof -
assume "P ⟹⇩τ P'" and "P' ⟹⇩l Rs"
thus "P ⟹⇩l Rs"
by(auto simp add: transition_def residualInject) (blast dest: rtrancl_trans)+
next
assume "P ⟹⇩τ P''" and "P'' ⟹⇩lu in P'''→a<x> ≺ P'"
thus "P ⟹⇩lu in P'''→a<x> ≺ P'"
apply(auto simp add: inputTransition_def residualInject)
by(blast dest: rtrancl_trans)+
next
assume PTrans: "P ⟹⇩l a<νx> ≺ P''"
assume P''Chain: "P'' ⟹⇩τ P'"
assume xFreshP: "x ♯ P"
from PTrans xFreshP obtain P''' P'''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼a<νx> ≺ P''''"
and P''''Chain: "P'''' ⟹⇩τ P''"
by(blast dest: transitionE)
from P''''Chain P''Chain have "P'''' ⟹⇩τ P'" by auto
with PChain P'''Trans show "P ⟹⇩la<νx> ≺ P'" by(rule transitionI)
next
assume PTrans: "P ⟹⇩lu in P'''→a<x> ≺ P''"
assume P''Chain: "P'' ⟹⇩τ P'"
from PTrans obtain P'''' where PChain: "P ⟹⇩τ P''''"
and P''''Trans: "P'''' ⟼a<x> ≺ P'''"
and P'''Chain: "P'''[x::=u] ⟹⇩τ P''"
by(blast dest: transitionE)
from P'''Chain P''Chain have "P'''[x::=u] ⟹⇩τ P'" by auto
with PChain P''''Trans show "P ⟹⇩lu in P'''→a<x> ≺ P'" by(blast intro: transitionI)
next
assume PTrans: "P ⟹⇩lα ≺ P''"
assume P''Chain: "P'' ⟹⇩τ P'"
from PTrans obtain P''' P'''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼α ≺ P''''"
and P''''Chain: "P'''' ⟹⇩τ P''"
by(blast dest: transitionE)
from P''''Chain P''Chain have "P'''' ⟹⇩τ P'" by auto
with PChain P'''Trans show "P ⟹⇩lα ≺ P'" by(rule transitionI)
qed
lemma freshInputTransition:
fixes P :: pi
and a :: name
and x :: name
and u :: name
and P'' :: pi
and P' :: pi
and c :: name
assumes PTrans: "P ⟹⇩lu in P''→a<x> ≺ P'"
and cFreshP: "c ♯ P"
and cinequ: "c ≠ u"
shows "c ♯ P'"
proof -
from PTrans obtain P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼a<x> ≺ P''"
and P''Chain: "P''[x::=u] ⟹⇩τ P'"
by(blast dest: transitionE)
from PChain cFreshP have cFreshP''': "c ♯ P'''" by(rule freshChain)
show "c ♯ P'"
proof(cases "x=c")
assume xeqc: "x=c"
from cinequ have "c ♯ P''[c::=u]" apply - by(rule fresh_fact2)
with P''Chain xeqc show ?thesis by(force intro: freshChain)
next
assume xineqc: "x≠c"
with P'''Trans cFreshP''' have "c ♯ P''" by(blast dest: freshBoundDerivative)
with cinequ have "c ♯ P''[x::=u]"
apply -
apply(rule fresh_fact1)
by simp
with P''Chain show ?thesis by(rule freshChain)
qed
qed
lemma freshBoundOutputTransition:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
and c :: name
assumes PTrans: "P ⟹⇩la<νx> ≺ P'"
and cFreshP: "c ♯ P"
and cineqx: "c ≠ x"
shows "c ♯ P'"
proof -
have Goal: "⋀P a x P' c. ⟦P ⟹⇩la<νx> ≺ P'; x ♯ P; c ♯ P; c ≠ x⟧ ⟹ c ♯ P'"
proof -
fix P a x P' c
assume PTrans: "P ⟹⇩la<νx> ≺ P'"
assume xFreshP: "x ♯ P"
assume cFreshP: "(c::name) ♯ P"
assume cineqx: "c ≠ x"
from PTrans xFreshP obtain P'' P''' where PTrans: "P ⟹⇩τ P''"
and P''Trans: "P'' ⟼a<νx> ≺ P'''"
and P'''Trans: "P''' ⟹⇩τ P'"
by(blast dest: transitionE)
from PTrans cFreshP have "c ♯ P''" by(rule freshChain)
with P''Trans cineqx have "c ♯ P'''" by(blast dest: Late_Semantics.freshBoundDerivative)
with P'''Trans show "c ♯ P'" by(rule freshChain)
qed
have "∃d::name. d ♯ (P, P', c)" by(blast intro: name_exists_fresh)
then obtain d::name where dFreshP: "d ♯ P" and dFreshP': "d ♯ P'" and cineqd: "c ≠ d"
by(force simp add: fresh_prod)
from PTrans dFreshP' have "P ⟹⇩la<νd> ≺ ([(x, d)] ∙ P')" by(simp add: alphaBoundResidual)
hence "c ♯ [(x, d)] ∙ P'" using dFreshP cFreshP cineqd by(rule Goal)
with cineqd cineqx show ?thesis by(simp add: name_fresh_left name_calc)
qed
lemma freshTauTransition:
fixes P :: pi
and c :: name
assumes PTrans: "P ⟹⇩lτ ≺ P'"
and cFreshP: "c ♯ P"
shows "c ♯ P'"
proof -
from PTrans have "P ⟹⇩τ P'" by(rule tauTransitionChain)
thus ?thesis using cFreshP by(rule freshChain)
qed
lemma freshOutputTransition:
fixes P :: pi
and a :: name
and b :: name
and P' :: pi
and c :: name
assumes PTrans: "P ⟹⇩la[b] ≺ P'"
and cFreshP: "c ♯ P"
shows "c ♯ P'"
proof -
from PTrans obtain P'' P''' where PTrans: "P ⟹⇩τ P''"
and P''Trans: "P'' ⟼a[b] ≺ P'''"
and P'''Trans: "P''' ⟹⇩τ P'"
by(blast dest: transitionE)
from PTrans cFreshP have "c ♯ P''" by(rule freshChain)
with P''Trans have "c ♯ P'''" by(blast dest: Late_Semantics.freshFreeDerivative)
with P'''Trans show ?thesis by(rule freshChain)
qed
lemma eqvtI:
fixes P :: pi
and Rs :: residual
and perm :: "name prm"
and u :: name
and P'' :: pi
and a :: name
and x :: name
and P' :: pi
shows "P ⟹⇩l Rs ⟹ (perm ∙ P) ⟹⇩l (perm ∙ Rs)"
and "P ⟹⇩lu in P''→a<x> ≺ P' ⟹ (perm ∙ P) ⟹⇩l(perm ∙ u) in (perm ∙ P'')→(perm ∙ a)<(perm ∙ x)> ≺ (perm ∙ P')"
proof -
assume "P ⟹⇩l Rs"
thus "(perm ∙ P) ⟹⇩l (perm ∙ Rs)"
proof(nominal_induct Rs avoiding: P rule: residual.strong_inducts)
case(BoundR a x P' P)
have PTrans: "P ⟹⇩la«x» ≺ P'" by fact
moreover then obtain b where aeqb: "a = BoundOutputS b" by(cases a, auto)
moreover have "x ♯ P" by fact
ultimately obtain P'' P''' where PTrans: "P ⟹⇩τ P''"
and P''Trans: "P'' ⟼b<νx> ≺ P'''"
and P'''Trans: "P''' ⟹⇩τ P'"
by(blast dest: transitionE)
from PTrans have "(perm ∙ P) ⟹⇩τ (perm ∙ P'')" by(rule eqvtChainI)
moreover from P''Trans have "(perm ∙ P'') ⟼ (perm ∙ (b<νx> ≺ P'''))"
by(rule eqvts)
moreover from P'''Trans have "(perm ∙ P''') ⟹⇩τ (perm ∙ P')" by(rule eqvtChainI)
ultimately show ?case using aeqb by(force intro: transitionI)
next
case(FreeR α P' P)
have "P ⟹⇩lα ≺ P'" by fact
then obtain P'' P''' where PTrans: "P ⟹⇩τ P''"
and P''Trans: "P'' ⟼α ≺ P'''"
and P'''Trans: "P''' ⟹⇩τ P'"
by(blast dest: transitionE)
from PTrans have "(perm ∙ P) ⟹⇩τ (perm ∙ P'')" by(rule eqvtChainI)
moreover from P''Trans have "(perm ∙ P'') ⟼ (perm ∙ (α ≺ P'''))"
by(rule eqvts)
moreover from P'''Trans have "(perm ∙ P''') ⟹⇩τ (perm ∙ P')" by(rule eqvtChainI)
ultimately show ?case by(force intro: transitionI)
qed
next
assume "P ⟹⇩lu in P''→a<x> ≺ P'"
then obtain P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼a<x> ≺ P''"
and P''Chain: "P''[x::=u] ⟹⇩τ P'"
by(blast dest: transitionE)
from PChain have "(perm ∙ P) ⟹⇩τ (perm ∙ P''')" by(rule eqvtChainI)
moreover from P'''Trans have "(perm ∙ P''') ⟼ (perm ∙ (a<x> ≺ P''))"
by(rule eqvts)
moreover from P''Chain have "(perm ∙ P''[x::=u]) ⟹⇩τ (perm ∙ P')" by(rule eqvtChainI)
ultimately show "(perm ∙ P) ⟹⇩l(perm ∙ u) in (perm ∙ P'')→(perm ∙ a)<(perm ∙ x)> ≺ (perm ∙ P')"
by(force intro: transitionI simp add: eqvt_subs[THEN sym] perm_bij)
qed
lemmas freshTransition = freshBoundOutputTransition freshOutputTransition
freshInputTransition freshTauTransition
end
Theory Weak_Late_Semantics
theory Weak_Late_Semantics
imports Weak_Late_Step_Semantics
begin
definition weakTransition :: "(pi × residual) set"
where "weakTransition ≡ Weak_Late_Step_Semantics.transition ∪ {x. ∃P. x = (P, τ ≺ P)}"
abbreviation weakLateTransition_judge :: "pi ⇒ residual ⇒ bool" ("_ ⟹⇩l⇧^_" [80, 80] 80)
where "P ⟹⇩l⇧^Rs ≡ (P, Rs) ∈ weakTransition"
lemma transitionI:
fixes P :: pi
and Rs :: residual
and P' :: pi
shows "P ⟹⇩l Rs ⟹ P ⟹⇩l⇧^Rs"
and "P ⟹⇩l⇧^τ ≺ P"
proof -
assume "P ⟹⇩l Rs"
thus "P ⟹⇩l⇧^Rs" by(simp add: weakTransition_def)
next
show "P ⟹⇩l⇧^τ ≺ P" by(simp add: weakTransition_def)
qed
lemma transitionCases[consumes 1, case_names Step Stay]:
fixes P :: pi
and Rs :: residual
and P' :: pi
assumes "P ⟹⇩l⇧^ Rs"
and "P ⟹⇩l Rs ⟹ F Rs"
and "Rs = τ ≺ P ⟹ F (τ ≺ P)"
shows "F Rs"
using assms
by(auto simp add: weakTransition_def)
lemma singleActionChain:
fixes P :: pi
and α :: freeRes
and P' :: pi
assumes "P ⟼α ≺ P'"
shows "P ⟹⇩l⇧^(α ≺ P')"
using assms
by(auto intro: Weak_Late_Step_Semantics.singleActionChain
simp add: weakTransition_def)
lemma Tau:
fixes P :: pi
shows "τ.(P) ⟹⇩l⇧^ τ ≺ P"
by(auto intro: Weak_Late_Step_Semantics.Tau
simp add: weakTransition_def)
lemma Output:
fixes a :: name
and b :: name
and P :: pi
shows "a{b}.P ⟹⇩l⇧^a[b] ≺ P"
by(auto intro: Weak_Late_Step_Semantics.Output
simp add: weakTransition_def)
lemma Match:
fixes a :: name
and P :: pi
and b :: name
and x :: name
and P' :: pi
and α :: freeRes
shows "P ⟹⇩l⇧^b<νx> ≺ P' ⟹ [a⌢a]P ⟹⇩l⇧^b<νx> ≺ P'"
and "P ⟹⇩l⇧^α ≺ P' ⟹ P ≠ P' ⟹ [a⌢a]P ⟹⇩l⇧^α ≺ P'"
by(auto simp add: residual.inject weakTransition_def intro: Weak_Late_Step_Semantics.Match)
lemma Mismatch:
fixes a :: name
and c :: name
and P :: pi
and b :: name
and x :: name
and P' :: pi
and α :: freeRes
shows "⟦P ⟹⇩l⇧^b<νx> ≺ P'; a ≠ c⟧ ⟹ [a≠c]P ⟹⇩l⇧^b<νx> ≺ P'"
and "P ⟹⇩l⇧^α ≺ P' ⟹ P ≠ P' ⟹ a ≠ c ⟹ [a≠c]P ⟹⇩l⇧^α ≺ P'"
by(auto simp add: residual.inject weakTransition_def intro: Weak_Late_Step_Semantics.Mismatch)
lemma Open:
fixes P :: pi
and a :: name
and b :: name
and P' :: pi
assumes Trans: "P ⟹⇩l⇧^a[b] ≺ P'"
and aInEqb: "a ≠ b"
shows "<νb>P ⟹⇩l⇧^a<νb> ≺ P'"
using assms
by(auto intro: Weak_Late_Step_Semantics.Open
simp add: weakTransition_def residual.inject)
lemma Par1B:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
assumes PTrans: "P ⟹⇩l⇧^a<νx> ≺ P'"
and xFreshQ: "x ♯ Q"
shows "P ∥ Q ⟹⇩l⇧^a<νx> ≺ (P' ∥ Q)"
using assms
by(auto intro: Weak_Late_Step_Semantics.Par1B
simp add: weakTransition_def residual.inject)
lemma Par1F:
fixes P :: pi
and α :: freeRes
and P' :: pi
assumes PTrans: "P ⟹⇩l⇧^α ≺ P'"
shows "P ∥ Q ⟹⇩l⇧^α ≺ (P' ∥ Q)"
using assms
by(auto intro: Weak_Late_Step_Semantics.Par1F
simp add: weakTransition_def residual.inject)
lemma Par2B:
fixes Q :: pi
and a :: name
and x :: name
and Q' :: pi
assumes QTrans: "Q ⟹⇩l⇧^a<νx> ≺ Q'"
and xFreshP: "x ♯ P"
shows "P ∥ Q ⟹⇩l⇧^a<νx> ≺ (P ∥ Q')"
using assms
by(auto intro: Weak_Late_Step_Semantics.Par2B
simp add: weakTransition_def residual.inject)
lemma Par2F:
fixes Q :: pi
and α :: freeRes
and Q' :: pi
assumes QTrans: "Q ⟹⇩l⇧^α ≺ Q'"
shows "P ∥ Q ⟹⇩l⇧^α ≺ (P ∥ Q')"
using assms
by(auto intro: Weak_Late_Step_Semantics.Par2F
simp add: weakTransition_def residual.inject)
lemma Comm1:
fixes P :: pi
and a :: name
and b :: name
and P'' :: pi
and P' :: pi
and Q :: pi
and Q' :: pi
assumes PTrans: "P ⟹⇩lb in P''→a<x> ≺ P'"
and QTrans: "Q ⟹⇩l⇧^a[b] ≺ Q'"
shows "P ∥ Q ⟹⇩l⇧^τ ≺ P' ∥ Q'"
using assms
by(auto intro: Weak_Late_Step_Semantics.Comm1
simp add: weakTransition_def residual.inject)
lemma Comm2:
fixes P :: pi
and a :: name
and b :: name
and Q'' :: pi
and P' :: pi
and Q :: pi
and Q' :: pi
assumes PTrans: "P ⟹⇩l⇧^a[b] ≺ P'"
and QTrans: "Q ⟹⇩lb in Q''→a<x> ≺ Q'"
shows "P ∥ Q ⟹⇩l⇧^τ ≺ P' ∥ Q'"
using assms
by(auto intro: Weak_Late_Step_Semantics.Comm2
simp add: weakTransition_def residual.inject)
lemma Close1:
fixes P :: pi
and y :: name
and P'' :: pi
and a :: name
and x :: name
and P' :: pi
and Q :: pi
and Q' :: pi
assumes PTrans: "P ⟹⇩ly in P''→a<x> ≺ P'"
and QTrans: "Q ⟹⇩l⇧^a<νy> ≺ Q'"
and xFreshP: "y ♯ P"
and xFreshQ: "y ♯ Q"
shows "P ∥ Q ⟹⇩l⇧^τ ≺ <νy>(P' ∥ Q')"
using assms
by(auto intro: Weak_Late_Step_Semantics.Close1
simp add: weakTransition_def residual.inject)
lemma Close2:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
and Q :: pi
and y :: name
and Q'' :: pi
and Q' :: pi
assumes PTrans: "P ⟹⇩l⇧^a<νy> ≺ P'"
and QTrans: "Q ⟹⇩ly in Q''→a<x> ≺ Q'"
and xFreshP: "y ♯ P"
and xFreshQ: "y ♯ Q"
shows "P ∥ Q ⟹⇩l⇧^τ ≺ <νy>(P' ∥ Q')"
using assms
by(auto intro: Weak_Late_Step_Semantics.Close2
simp add: weakTransition_def residual.inject)
lemma ResF:
fixes P :: pi
and α :: freeRes
and P' :: pi
and x :: name
assumes PTrans: "P ⟹⇩l⇧^α ≺ P'"
and xFreshAlpha: "x ♯ α"
shows "<νx>P ⟹⇩l⇧^α ≺ <νx>P'"
using assms
by(auto intro: Weak_Late_Step_Semantics.ResF
simp add: weakTransition_def residual.inject)
lemma ResB:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
and y :: name
assumes PTrans: "P ⟹⇩l⇧^a<νx> ≺ P'"
and yineqa: "y ≠ a"
and yineqx: "y ≠ x"
and xFreshP: "x ♯ P"
shows "<νy>P ⟹⇩l⇧^a<νx> ≺ (<νy>P')"
using assms
by(auto intro: Weak_Late_Step_Semantics.ResB
simp add: weakTransition_def residual.inject)
lemma Bang:
fixes P :: pi
and Rs :: residual
assumes "P ∥ !P ⟹⇩l⇧^ Rs"
and "Rs ≠ τ ≺ P ∥ !P"
shows "!P ⟹⇩l⇧^ Rs"
using assms
by(auto intro: Weak_Late_Step_Semantics.Bang
simp add: weakTransition_def residual.inject)
lemma tauTransitionChain:
fixes P :: pi
and P' :: pi
assumes "P ⟹⇩l⇧^τ ≺ P'"
shows "P ⟹⇩τ P'"
using assms
by(auto intro: Weak_Late_Step_Semantics.tauTransitionChain
simp add: weakTransition_def residual.inject transition_def)
lemma chainTransitionAppend:
fixes P :: pi
and P' :: pi
and Rs :: residual
and a :: name
and x :: name
and P'' :: pi
and α :: freeRes
shows "P ⟹⇩τ P' ⟹ P' ⟹⇩l⇧^ Rs ⟹ P ⟹⇩l⇧^ Rs"
and "P ⟹⇩l⇧^a<νx> ≺ P'' ⟹ P'' ⟹⇩τ P' ⟹ x ♯ P ⟹ P ⟹⇩l⇧^a<νx> ≺ P'"
and "P ⟹⇩l⇧^α ≺ P'' ⟹ P'' ⟹⇩τ P' ⟹ P ⟹⇩l⇧^α ≺ P'"
proof -
assume "P ⟹⇩τ P'" and "P' ⟹⇩l⇧^ Rs"
thus "P ⟹⇩l⇧^ Rs"
by(auto intro: Weak_Late_Step_Semantics.chainTransitionAppend
Weak_Late_Step_Semantics.tauActionChain
simp add: weakTransition_def residual.inject)
next
assume "P ⟹⇩l⇧^a<νx> ≺ P''" and "P'' ⟹⇩τ P'" and "x ♯ P"
thus "P ⟹⇩l⇧^a<νx> ≺ P'"
by(auto intro: Weak_Late_Step_Semantics.chainTransitionAppend
simp add: weakTransition_def residual.inject)
next
assume "P ⟹⇩l⇧^α ≺ P''" and "P'' ⟹⇩τ P'"
thus "P ⟹⇩l⇧^α ≺ P'"
apply(case_tac "P''=P'")
by(auto dest: Weak_Late_Step_Semantics.chainTransitionAppend
Weak_Late_Step_Semantics.tauActionChain
simp add: weakTransition_def residual.inject)
qed
lemma weakEqWeakTransitionAppend:
fixes P :: pi
and P' :: pi
and α :: freeRes
and P'' :: pi
assumes PTrans: "P ⟹⇩lτ ≺ P'"
and P'Trans: "P' ⟹⇩l⇧^α ≺ P''"
shows "P ⟹⇩lα ≺ P''"
proof(cases "α=τ")
assume alphaEqTau: "α = τ"
with P'Trans have "P' ⟹⇩τ P''" by(blast intro: tauTransitionChain)
with PTrans alphaEqTau show ?thesis
by(blast intro: Weak_Late_Step_Semantics.chainTransitionAppend)
next
assume alphaIneqTau: "α ≠ τ"
from PTrans have "P ⟹⇩τ P'" by(rule Weak_Late_Step_Semantics.tauTransitionChain)
moreover from P'Trans alphaIneqTau have "P' ⟹⇩lα ≺ P''"
by(auto simp add: weakTransition_def residual.inject)
ultimately show ?thesis
by(rule Weak_Late_Step_Semantics.chainTransitionAppend)
qed
lemma freshBoundOutputTransition:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
and c :: name
assumes PTrans: "P ⟹⇩l⇧^a<νx> ≺ P'"
and cFreshP: "c ♯ P"
and cineqx: "c ≠ x"
shows "c ♯ P'"
using assms
by(auto intro: Weak_Late_Step_Semantics.freshBoundOutputTransition
simp add: weakTransition_def residual.inject)
lemma freshTauTransition:
fixes P :: pi
and c :: name
assumes PTrans: "P ⟹⇩l⇧^τ ≺ P'"
and cFreshP: "c ♯ P"
shows "c ♯ P'"
using assms
by(auto intro: Weak_Late_Step_Semantics.freshTauTransition
simp add: weakTransition_def residual.inject)
lemma freshOutputTransition:
fixes P :: pi
and a :: name
and b :: name
and P' :: pi
and c :: name
assumes PTrans: "P ⟹⇩l⇧^a[b] ≺ P'"
and cFreshP: "c ♯ P"
shows "c ♯ P'"
using assms
by(auto intro: Weak_Late_Step_Semantics.freshOutputTransition
simp add: weakTransition_def residual.inject)
lemma eqvtI:
fixes P :: pi
and Rs :: residual
and perm :: "name prm"
assumes "P ⟹⇩l⇧^ Rs"
shows "(perm ∙ P) ⟹⇩l⇧^ (perm ∙ Rs)"
using assms
by(auto intro: Weak_Late_Step_Semantics.eqvtI
simp add: weakTransition_def residual.inject)
lemma freshInputTransition:
fixes P :: pi
and a :: name
and b :: name
and P' :: pi
and c :: name
assumes PTrans: "P ⟹⇩l⇧^a<b> ≺ P'"
and cFreshP: "c ♯ P"
and cineqb: "c ≠ b"
shows "c ♯ P'"
using assms
by(auto intro: Weak_Late_Step_Semantics.freshInputTransition
simp add: weakTransition_def residual.inject)
lemmas freshTransition = freshBoundOutputTransition freshOutputTransition
freshInputTransition freshTauTransition
end
Theory Weak_Late_Sim
theory Weak_Late_Sim
imports Weak_Late_Semantics Strong_Late_Sim
begin
definition weakSimAct :: "pi ⇒ residual ⇒ ('a::fs_name) ⇒ (pi × pi) set ⇒ bool" where
"weakSimAct P Rs C Rel ≡ (∀Q' a x. Rs = a<νx> ≺ Q' ⟶ x ♯ C ⟶ (∃P' . P ⟹⇩l⇧^a<νx> ≺ P' ∧ (P', Q') ∈ Rel)) ∧
(∀Q' a x. Rs = a<x> ≺ Q' ⟶ x ♯ C ⟶ (∃P''. ∀u. ∃P'. P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel)) ∧
(∀Q' α. Rs = α ≺ Q' ⟶ (∃P'. P ⟹⇩l⇧^α ≺ P' ∧ (P', Q') ∈ Rel))"
definition weakSimAux :: "pi ⇒ (pi × pi) set ⇒ pi ⇒ bool" where
"weakSimAux P Rel Q ≡ (∀Q' a x. (Q ⟼ a<νx> ≺ Q' ∧ x ♯ P) ⟶ (∃P' . P ⟹⇩l⇧^a<νx> ≺ P' ∧ (P', Q') ∈ Rel)) ∧
(∀Q' a x. (Q ⟼ a<x> ≺ Q' ∧ x ♯ P) ⟶ (∃P''. ∀u. ∃P'. P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel)) ∧
(∀Q' α. Q ⟼ α ≺ Q' ⟶ (∃P'. P ⟹⇩l⇧^α ≺ P' ∧ (P', Q') ∈ Rel))"
definition weakSimulation :: "pi ⇒ (pi × pi) set ⇒ pi ⇒ bool" ("_ ↝⇧^<_> _" [80, 80, 80] 80) where
"P ↝⇧^<Rel> Q ≡ (∀Rs. Q ⟼ Rs ⟶ weakSimAct P Rs P Rel)"
lemmas simDef = weakSimAct_def weakSimulation_def
lemma "weakSimAux P Rel Q = weakSimulation P Rel Q"
by(auto simp add: weakSimAux_def simDef)
lemma monotonic:
fixes A :: "(pi × pi) set"
and B :: "(pi × pi) set"
and P :: pi
and P' :: pi
assumes "P ↝⇧^<A> P'"
and "A ⊆ B"
shows "P ↝⇧^<B> P'"
using assms
apply(auto simp add: simDef)
apply blast
apply(erule_tac x="a<x> ≺ Q'" in allE)
apply(clarsimp)
apply(rotate_tac 4)
apply(erule_tac x=Q' in allE)
apply(erule_tac x=a in allE)
apply(erule_tac x=x in allE)
by blast+
lemma simCasesCont[consumes 1, case_names Bound Input Free]:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and C :: "'a::fs_name"
assumes Eqvt: "eqvt Rel"
and Bound: "⋀Q' a x. ⟦x ♯ C; Q ⟼a<νx> ≺ Q'⟧ ⟹ ∃P'. P ⟹⇩l⇧^a<νx> ≺ P' ∧ (P', Q') ∈ Rel"
and Input: "⋀Q' a x. ⟦x ♯ C; Q ⟼a<x> ≺ Q'⟧ ⟹ ∃P''. ∀u. ∃P'. P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel"
and Free: "⋀Q' α. Q ⟼ α ≺ Q' ⟹ (∃P'. P ⟹⇩l⇧^ α ≺ P' ∧ (P', Q') ∈ Rel)"
shows "P ↝⇧^<Rel> Q"
using Free
proof(auto simp add: simDef)
fix Q' a x
assume xFreshP: "(x::name) ♯ P"
assume Trans: "Q ⟼ a<νx> ≺ Q'"
have "∃c::name. c ♯ (P, Q', x, C)" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshP: "c ♯ P" and cFreshQ': "c ♯ Q'" and cFreshC: "c ♯ C"
and cineqx: "c ≠ x"
by(force simp add: fresh_prod)
from Trans cFreshQ' have "Q ⟼ a<νc> ≺ ([(x, c)] ∙ Q')" by(simp add: alphaBoundResidual)
with cFreshC have "∃P'. P ⟹⇩l⇧^ a<νc> ≺ P' ∧ (P', [(x, c)] ∙ Q') ∈ Rel"
by(rule Bound)
then obtain P' where PTrans: "P ⟹⇩l⇧^a<νc> ≺ P'" and P'RelQ': "(P', [(x, c)] ∙ Q') ∈ Rel"
by blast
from PTrans xFreshP cineqx have xFreshP': "x ♯ P'" by(force dest: freshTransition)
with PTrans have "P ⟹⇩l⇧^ a<νx> ≺ ([(x, c)] ∙ P')" by(simp add: alphaBoundResidual name_swap)
moreover have "([(x, c)] ∙ P', Q') ∈ Rel" (is "?goal")
proof -
from Eqvt P'RelQ' have "([(x, c)] ∙ P', [(x, c)] ∙ [(x, c)] ∙ Q') ∈ Rel"
by(rule eqvtRelI)
with cineqx show ?goal by(simp add: name_calc)
qed
ultimately show "∃P'. P ⟹⇩l⇧^a<νx> ≺ P' ∧ (P', Q') ∈ Rel" by blast
next
fix Q' a x u
assume QTrans: "Q ⟼a<x> ≺ (Q'::pi)"and xFreshP: "x ♯ P"
have "∃c::name. c ♯ (P, Q', C, x)" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshP: "c ♯ P" and cFreshQ': "c ♯ Q'" and cFreshC: "c ♯ C"
and cineqx: "c ≠ x"
by(force simp add: fresh_prod)
from QTrans cFreshQ' have "Q ⟼a<c> ≺ ([(x, c)] ∙ Q')" by(simp add: alphaBoundResidual)
with cFreshC have "∃P''. ∀u. ∃P'. P ⟹⇩lu in P''→a<c> ≺ P' ∧ (P', ([(x, c)] ∙ Q')[c::=u]) ∈ Rel"
by(rule Input)
then obtain P'' where L1: "∀u. ∃P'. P ⟹⇩lu in P''→a<c> ≺ P' ∧ (P', ([(x, c)] ∙ Q')[c::=u]) ∈ Rel" by blast
have "∀u. ∃P'. P ⟹⇩lu in ([(c, x)] ∙ P'')→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel"
proof(auto)
fix u
from L1 obtain P' where PTrans: "P ⟹⇩lu in P''→a<c> ≺ P'" and P'RelQ': "(P', ([(x, c)] ∙ Q')[c::=u]) ∈ Rel"
by blast
from PTrans xFreshP have "P ⟹⇩lu in ([(c, x)] ∙ P'')→a<x> ≺ P'" by(rule alphaInput)
moreover from P'RelQ' cFreshQ' have "(P', Q'[x::=u]) ∈ Rel" by(simp add: renaming[THEN sym] name_swap)
ultimately show "∃P'. P ⟹⇩lu in ([(c, x)] ∙ P'')→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel" by blast
qed
thus "∃P''. ∀u. ∃P'. P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel" by blast
qed
lemma simCases[case_names Bound Input Free]:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and C :: "'a::fs_name"
assumes Bound: "⋀Q' a x. ⟦Q ⟼a<νx> ≺ Q'; x ♯ P⟧ ⟹ ∃P'. P ⟹⇩l⇧^a<νx> ≺ P' ∧ (P', Q') ∈ Rel"
and Input: "⋀Q' a x. ⟦Q ⟼a<x> ≺ Q'; x ♯ P⟧ ⟹ ∃P''. ∀u. ∃P'. P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel"
and Free: "⋀Q' α. Q ⟼ α ≺ Q' ⟹ (∃P'. P ⟹⇩l⇧^ α ≺ P' ∧ (P', Q') ∈ Rel)"
shows "P ↝⇧^<Rel> Q"
using assms
by(auto simp add: simDef)
lemma simActBoundCases[consumes 1, case_names Input BoundOutput]:
fixes P :: pi
and a :: subject
and x :: name
and Q' :: pi
and C :: "'a::fs_name"
and Rel :: "(pi × pi) set"
assumes EqvtRel: "eqvt Rel"
and DerInput: "⋀b. a = InputS b ⟹ (∃P''. ∀u. ∃P'. (P ⟹⇩lu in P''→b<x> ≺ P') ∧ (P', Q'[x::=u]) ∈ Rel)"
and DerBoundOutput: "⋀b. a = BoundOutputS b ⟹ (∃P'. (P ⟹⇩l⇧^b<νx> ≺ P') ∧ (P', Q') ∈ Rel)"
shows "weakSimAct P (a«x» ≺ Q') P Rel"
proof(simp add: weakSimAct_def fresh_prod, auto)
fix Q'' b y
assume Eq: "a«x» ≺ Q' = b<νy> ≺ Q''"
assume yFreshP: "y ♯ P"
from Eq have "a = BoundOutputS b" by(simp add: residual.inject)
from yFreshP DerBoundOutput[OF this] Eq show "∃P'. P ⟹⇩l⇧^b<νy> ≺ P' ∧ (P', Q'') ∈ Rel"
proof(cases "x=y", auto simp add: residual.inject name_abs_eq)
fix P'
assume PTrans: "P ⟹⇩l⇧^b<νx> ≺ P'"
assume P'RelQ': "(P', ([(x, y)] ∙ Q'')) ∈ Rel"
assume xineqy: "x ≠ y"
with PTrans yFreshP have yFreshP': "y ♯ P'"
by(force intro: freshTransition)
hence "b<νx> ≺ P' = b<νy> ≺ [(x, y)] ∙ P'" by(rule alphaBoundResidual)
moreover have "([(x, y)] ∙ P', Q'') ∈ Rel"
proof -
from EqvtRel P'RelQ' have "([(x, y)] ∙ P', [(x, y)] ∙ ([(x, y)] ∙ Q''))∈ Rel"
by(rule eqvtRelI)
thus ?thesis by(simp add: name_calc)
qed
ultimately show "∃P'. P ⟹⇩l⇧^b<νy> ≺ P' ∧ (P', Q'') ∈ Rel" using PTrans by auto
qed
next
fix Q'' b y u
assume Eq: "a«x» ≺ Q' = b<y> ≺ Q''"
assume yFreshP: "y ♯ P"
from Eq have "a = InputS b" by(simp add: residual.inject)
from DerInput[OF this] obtain P'' where L1: "∀u. ∃P'. P ⟹⇩lu in P''→b<x> ≺ P' ∧
(P', Q'[x::=u]) ∈ Rel"
by blast
have "∀u. ∃P'. P ⟹⇩lu in ([(x, y)] ∙ P'')→b<y> ≺ P' ∧ (P', Q''[y::=u]) ∈ Rel"
proof(rule allI)
fix u
from L1 Eq show "∃P'. P ⟹⇩lu in ([(x, y)] ∙ P'')→b<y> ≺ P' ∧ (P', Q''[y::=u]) ∈ Rel"
proof(cases "x=y", auto simp add: residual.inject name_abs_eq)
assume Der: "∀u. ∃P'. P ⟹⇩lu in P''→b<x> ≺ P' ∧ (P', ([(x, y)] ∙ Q'')[x::=u]) ∈ Rel"
assume xFreshQ'': "x ♯ Q''"
from Der obtain P' where PTrans: "P ⟹⇩lu in P''→b<x> ≺ P'"
and P'RelQ': "(P', ([(x, y)] ∙ Q'')[x::=u]) ∈ Rel"
by force
from PTrans yFreshP have "P ⟹⇩lu in ([(x, y)] ∙ P'')→b<y> ≺ P'" by(rule alphaInput)
moreover from xFreshQ'' P'RelQ' have "(P', Q''[y::=u]) ∈ Rel"
by(simp add: renaming)
ultimately show ?thesis by force
qed
qed
thus "∃P''. ∀u. ∃P'. P ⟹⇩lu in P''→b<y> ≺ P' ∧ (P', Q''[y::=u]) ∈ Rel"
by blast
qed
lemma simActFreeCases[consumes 0, case_names Der]:
fixes P :: pi
and α :: freeRes
and Q' :: pi
and Rel :: "(pi × pi) set"
assumes "∃P'. (P ⟹⇩l⇧^α ≺ P') ∧ (P', Q') ∈ Rel"
shows "weakSimAct P (α ≺ Q') P Rel"
using assms
by(simp add: residual.inject weakSimAct_def fresh_prod)
lemma simE:
fixes P :: pi
and Rel :: "(pi × pi) set"
and Q :: pi
and a :: name
and x :: name
and u :: name
and Q' :: pi
assumes "P ↝⇧^<Rel> Q"
shows "Q ⟼a<νx> ≺ Q' ⟹ x ♯ P ⟹ ∃P'. P ⟹⇩l⇧^a<νx> ≺ P' ∧ (P', Q') ∈ Rel"
and "Q ⟼a<x> ≺ Q' ⟹ x ♯ P ⟹ ∃P''. ∀u. ∃P'. P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel"
and "Q ⟼α ≺ Q' ⟹ (∃P'. P ⟹⇩l⇧^α ≺ P' ∧ (P', Q') ∈ Rel)"
using assms by(simp add: simDef)+
lemma weakSimTauChain:
fixes P :: pi
and Rel :: "(pi × pi) set"
and Q :: pi
and Q' :: pi
assumes QChain: "Q ⟹⇩τ Q'"
and PRelQ: "(P, Q) ∈ Rel"
and Sim: "⋀P Q. (P, Q) ∈ Rel ⟹ P ↝⇧^<Rel> Q"
shows "∃P'. P ⟹⇩τ P' ∧ (P', Q') ∈ Rel"
proof -
from QChain show ?thesis
proof(induct rule: tauChainInduct)
case id
have "P ⟹⇩τ P" by simp
with PRelQ show ?case by blast
next
case(ih Q' Q'')
have IH: "∃P'. P ⟹⇩τ P' ∧ (P', Q') ∈ Rel" by fact
then obtain P' where PChain: "P ⟹⇩τ P'" and P'RelQ': "(P', Q') ∈ Rel" by blast
from P'RelQ' have "P' ↝⇧^<Rel> Q'" by(rule Sim)
moreover have Q'Trans: "Q' ⟼τ ≺ Q''" by fact
ultimately have "∃P''. P' ⟹⇩l⇧^τ ≺ P'' ∧ (P'', Q'') ∈ Rel" by(rule simE)
then obtain P'' where P'Trans: "P' ⟹⇩l⇧^τ ≺ P''" and P''RelQ'': "(P'', Q'') ∈ Rel" by blast
from P'Trans have "P' ⟹⇩τ P''" by(rule tauTransitionChain)
with PChain have "P ⟹⇩τ P''" by auto
with P''RelQ'' show ?case by blast
qed
qed
lemma simE2:
fixes P :: pi
and Rel :: "(pi × pi) set"
and Q :: pi
and a :: name
and x :: name
and Q' :: pi
assumes PSimQ: "P ↝⇧^<Rel> Q"
and Sim: "⋀P Q. (P, Q) ∈ Rel ⟹ P ↝⇧^<Rel> Q"
and Eqvt: "eqvt Rel"
and PRelQ: "(P, Q) ∈ Rel"
shows "Q ⟹⇩l⇧^a<νx> ≺ Q' ⟹ x ♯ P ⟹ ∃P'. P ⟹⇩l⇧^a<νx> ≺ P' ∧ (P', Q') ∈ Rel"
and "Q ⟹⇩l⇧^α ≺ Q' ⟹ ∃P'. P ⟹⇩l⇧^α ≺ P' ∧ (P', Q') ∈ Rel"
proof -
assume QTrans: "Q ⟹⇩l⇧^a<νx> ≺ Q'"
assume xFreshP: "x ♯ P"
have Goal: "⋀P Q a x Q'. ⟦P ↝⇧^<Rel> Q; Q ⟹⇩l⇧^a<νx> ≺ Q'; x ♯ P; x ♯ Q; (P, Q) ∈ Rel⟧ ⟹
∃P'. P ⟹⇩l⇧^a<νx> ≺ P' ∧ (P', Q') ∈ Rel"
proof -
fix P Q a x Q'
assume PSimQ: "P ↝⇧^<Rel> Q"
assume QTrans: "Q ⟹⇩l⇧^a<νx> ≺ Q'"
assume xFreshP: "x ♯ P"
assume xFreshQ: "x ♯ Q"
assume PRelQ: "(P, Q) ∈ Rel"
from QTrans xFreshQ obtain Q'' Q''' where QChain: "Q ⟹⇩τ Q''"
and Q''Trans: "Q'' ⟼a<νx> ≺ Q'''"
and Q'''Chain: "Q''' ⟹⇩τ Q'"
by(force dest: Weak_Late_Step_Semantics.transitionE simp add: weakTransition_def)
from QChain PRelQ Sim have "∃P''. P ⟹⇩τ P'' ∧ (P'', Q'') ∈ Rel"
by(rule weakSimTauChain)
then obtain P'' where PChain: "P ⟹⇩τ P''" and P''RelQ'': "(P'', Q'') ∈ Rel" by blast
from PChain xFreshP have xFreshP'': "x ♯ P''" by(rule freshChain)
from P''RelQ'' have "P'' ↝⇧^<Rel> Q''" by(rule Sim)
hence "∃P'''. P'' ⟹⇩l⇧^a<νx> ≺ P''' ∧ (P''', Q''') ∈ Rel" using Q''Trans xFreshP''
by(rule simE)
then obtain P''' where P''Trans: "P'' ⟹⇩l⇧^a<νx> ≺ P'''" and P'''RelQ''': "(P''', Q''') ∈ Rel"
by blast
from P'''RelQ''' have "P''' ↝⇧^<Rel> Q'''" by(rule Sim)
have "∃P'. P''' ⟹⇩τ P' ∧ (P', Q') ∈ Rel" using Q'''Chain P'''RelQ''' Sim
by(rule weakSimTauChain)
then obtain P' where P'''Chain: "P''' ⟹⇩τ P'" and P'RelQ': "(P', Q') ∈ Rel" by blast
from PChain P''Trans P'''Chain xFreshP'' have "P ⟹⇩l⇧^a<νx> ≺ P'"
by(blast dest: chainTransitionAppend)
with P'RelQ' show "∃P'. P ⟹⇩l⇧^ a<νx> ≺ P' ∧ (P', Q') ∈ Rel" by blast
qed
have "∃c::name. c ♯ (Q, Q', P, x)" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshQ: "c ♯ Q" and cFreshQ': "c ♯ Q'" and cFreshP: "c ♯ P"
and xineqc: "x ≠ c"
by(force simp add: fresh_prod)
from QTrans cFreshQ' have "Q ⟹⇩l⇧^a<νc> ≺ ([(x, c)] ∙ Q')" by(simp add: alphaBoundResidual)
with PSimQ have "∃P'. P ⟹⇩l⇧^a<νc> ≺ P' ∧ (P', [(x, c)] ∙ Q') ∈ Rel" using cFreshP cFreshQ ‹(P, Q) ∈ Rel›
by(rule Goal)
then obtain P' where PTrans: "P ⟹⇩l⇧^a<νc> ≺ P'" and P'RelQ': "(P', [(x, c)] ∙ Q') ∈ Rel"
by force
have "P ⟹⇩l⇧^a<νx> ≺ ([(x, c)] ∙ P')"
proof -
from PTrans xFreshP xineqc have "x ♯ P'" by(rule freshTransition)
with PTrans show ?thesis by(simp add: alphaBoundResidual name_swap)
qed
moreover have "([(x, c)] ∙ P', Q') ∈ Rel"
proof -
from Eqvt P'RelQ' have "([(x, c)] ∙ P', [(x, c)] ∙ [(x, c)] ∙ Q') ∈ Rel"
by(rule eqvtRelI)
thus ?thesis by simp
qed
ultimately show "∃P'. P ⟹⇩l⇧^ a<νx> ≺ P' ∧ (P', Q') ∈ Rel" by blast
next
assume QTrans: "Q ⟹⇩l⇧^α ≺ Q'"
thus "∃P'. P ⟹⇩l⇧^α ≺ P' ∧ (P', Q') ∈ Rel"
proof(induct rule: transitionCases)
case Step
have "Q ⟹⇩lα ≺ Q'" by fact
then obtain Q'' Q''' where QChain: "Q ⟹⇩τ Q''"
and Q''Trans: "Q'' ⟼α ≺ Q'''"
and Q'''Chain: "Q''' ⟹⇩τ Q'"
by(blast dest: Weak_Late_Step_Semantics.transitionE)
from QChain PRelQ Sim have "∃P''. P ⟹⇩τ P'' ∧ (P'', Q'') ∈ Rel"
by(rule weakSimTauChain)
then obtain P'' where PChain: "P ⟹⇩τ P''" and P''RelQ'': "(P'', Q'') ∈ Rel" by blast
from P''RelQ'' have "P'' ↝⇧^<Rel> Q''" by(rule Sim)
hence "∃P'''. P'' ⟹⇩l⇧^α ≺ P''' ∧ (P''', Q''') ∈ Rel" using Q''Trans
by(rule simE)
then obtain P''' where P''Trans: "P'' ⟹⇩l⇧^α ≺ P'''" and P'''RelQ''': "(P''', Q''') ∈ Rel"
by blast
from P'''RelQ''' have "P''' ↝⇧^<Rel> Q'''" by(rule Sim)
have "∃P'. P''' ⟹⇩τ P' ∧ (P', Q') ∈ Rel" using Q'''Chain P'''RelQ''' Sim
by(rule weakSimTauChain)
then obtain P' where P'''Chain: "P''' ⟹⇩τ P'" and P'RelQ': "(P', Q') ∈ Rel" by blast
from PChain P''Trans P'''Chain have "P ⟹⇩l⇧^α ≺ P'"
by(blast dest: chainTransitionAppend)
with P'RelQ' show ?case by blast
next
case Stay
have "α ≺ Q' = τ ≺ Q" by fact
hence "Q = Q'" and "α = τ" by(simp add: residual.inject)+
moreover have "P ⟹⇩l⇧^τ ≺ P" by(simp add: weakTransition_def)
ultimately show ?case using PRelQ by blast
qed
qed
lemma eqvtI:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and perm :: "name prm"
assumes Sim: "P ↝⇧^<Rel> Q"
and RelRel': "Rel ⊆ Rel'"
and EqvtRel': "eqvt Rel'"
shows "(perm ∙ P) ↝⇧^<Rel'> (perm ∙ Q)"
proof -
from EqvtRel' show ?thesis
proof(induct rule: simCasesCont[of _ "(perm ∙ P)"])
case(Bound Q' a x)
have Trans: "(perm ∙ Q) ⟼ a<νx> ≺ Q'" and xFreshP: "x ♯ perm ∙ P" by fact+
from Trans have "(rev perm ∙ (perm ∙ Q)) ⟼ rev perm ∙ (a<νx> ≺ Q')"
by(rule eqvts)
hence "Q ⟼ (rev perm ∙ a)<ν(rev perm ∙ x)> ≺ (rev perm ∙ Q')"
by(simp add: name_rev_per)
moreover from xFreshP have "(rev perm ∙ x) ♯ P" by(simp add: name_fresh_left)
ultimately have "∃P'. P ⟹⇩l⇧^ (rev perm ∙ a)<ν(rev perm ∙ x)> ≺ P' ∧ (P', rev perm ∙ Q') ∈ Rel" using Sim
by(force intro: simE)
then obtain P' where PTrans: "P ⟹⇩l⇧^ (rev perm ∙ a)<ν(rev perm ∙ x)> ≺ P'" and P'RelQ': "(P', rev perm ∙ Q') ∈ Rel" by blast
from PTrans have "(perm ∙ P) ⟹⇩l⇧^ perm ∙ ((rev perm ∙ a)<ν(rev perm ∙ x)> ≺ P')"
by(rule Weak_Late_Semantics.eqvtI)
hence L1: "(perm ∙ P) ⟹⇩l⇧^ a<νx> ≺ (perm ∙ P')" by(simp add: name_per_rev)
from P'RelQ' RelRel' have "(P', rev perm ∙ Q') ∈ Rel'" by blast
with EqvtRel' have "(perm ∙ P', perm ∙ (rev perm ∙ Q')) ∈ Rel'"
by(rule eqvtRelI)
hence "(perm ∙ P', Q') ∈ Rel'" by(simp add: name_per_rev)
with L1 show ?case by blast
next
case(Input Q' a x)
have Trans: "(perm ∙ Q) ⟼a<x> ≺ Q'" and xFreshP: "x ♯ perm ∙ P" by fact+
from Trans have "(rev perm ∙ (perm ∙ Q)) ⟼ rev perm ∙ (a<x> ≺ Q')"
by(rule eqvts)
hence "Q ⟼ (rev perm ∙ a)<(rev perm ∙ x)> ≺ (rev perm ∙ Q')"
by(simp add: name_rev_per)
moreover from xFreshP have xFreshP: "(rev perm ∙ x) ♯ P" by(simp add: name_fresh_left)
ultimately have "∃P''. ∀u. ∃P'. P ⟹⇩lu in P''→(rev perm ∙ a)<(rev perm ∙ x)> ≺ P' ∧ (P', (rev perm ∙ Q')[(rev perm ∙ x)::=u]) ∈ Rel" using Sim
by(force intro: simE)
then obtain P'' where L1: "∀u. ∃P'. P ⟹⇩lu in P''→(rev perm ∙ a)<(rev perm ∙ x)> ≺ P' ∧ (P', (rev perm ∙ Q')[(rev perm ∙ x)::=u]) ∈ Rel"
by blast
have "∀u. ∃P'. (perm ∙ P) ⟹⇩lu in (perm ∙ P'')→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel'"
proof(rule allI)
fix u
from L1 obtain P' where PTrans: "P ⟹⇩l(rev perm ∙ u) in P''→(rev perm ∙ a)<(rev perm ∙ x)> ≺ P'"
and P'RelQ': "(P', (rev perm ∙ Q')[(rev perm ∙ x)::=(rev perm ∙ u)]) ∈ Rel" by blast
from PTrans have "(perm ∙ P) ⟹⇩l(perm ∙ (rev perm ∙ u)) in (perm ∙ P'')→(perm ∙ rev perm ∙ a)<(perm ∙ rev perm ∙ x)> ≺ (perm ∙ P')"
by(rule_tac Weak_Late_Step_Semantics.eqvtI, auto)
hence L2: "(perm ∙ P) ⟹⇩lu in (perm ∙ P'')→a<x> ≺ (perm ∙ P')" by(simp add: name_per_rev)
from P'RelQ' RelRel' have "(P', (rev perm ∙ Q')[(rev perm ∙ x)::=(rev perm ∙ u)]) ∈ Rel'" by blast
with EqvtRel' have "(perm ∙ P', perm ∙ ((rev perm ∙ Q')[(rev perm ∙ x)::=(rev perm ∙ u)])) ∈ Rel'"
by(rule eqvtRelI)
hence "(perm ∙ P', Q'[x::=u]) ∈ Rel'" by(simp add: name_per_rev eqvt_subs[THEN sym] name_calc)
with L2 show "∃P'. (perm ∙ P) ⟹⇩lu in (perm ∙ P'')→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel'" by blast
qed
thus ?case by blast
next
case(Free Q' α)
have Trans: "(perm ∙ Q) ⟼ α ≺ Q'" by fact
from Trans have "(rev perm ∙ (perm ∙ Q)) ⟼ rev perm ∙ (α ≺ Q')"
by(rule eqvts)
hence "Q ⟼ (rev perm ∙ α) ≺ (rev perm ∙ Q')"
by(simp add: name_rev_per)
with Sim have "(∃P'. P ⟹⇩l⇧^ (rev perm ∙ α) ≺ P' ∧ (P', (rev perm ∙ Q')) ∈ Rel)"
by(rule simE)
then obtain P' where PTrans: "P ⟹⇩l⇧^ (rev perm ∙ α) ≺ P'" and PRel: "(P', (rev perm ∙ Q')) ∈ Rel" by blast
from PTrans have "(perm ∙ P) ⟹⇩l⇧^ perm ∙ ((rev perm ∙ α)≺ P')"
by(rule Weak_Late_Semantics.eqvtI)
hence L1: "(perm ∙ P) ⟹⇩l⇧^ α ≺ (perm ∙ P')" by(simp add: name_per_rev)
from PRel EqvtRel' RelRel' have "((perm ∙ P'), (perm ∙ (rev perm ∙ Q'))) ∈ Rel'"
by(force intro: eqvtRelI)
hence "((perm ∙ P'), Q') ∈ Rel'" by(simp add: name_per_rev)
with L1 show ?case by blast
qed
qed
lemma reflexive:
fixes P :: pi
and Rel :: "(pi × pi) set"
assumes "Id ⊆ Rel"
shows "P ↝⇧^<Rel> P"
using assms
by(auto intro: Weak_Late_Step_Semantics.singleActionChain
simp add: simDef weakTransition_def)
lemma transitive:
fixes P :: pi
and Q :: pi
and R :: pi
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
and Rel'' :: "(pi × pi) set"
assumes QSimR: "Q ↝⇧^<Rel'> R"
and Eqvt: "eqvt Rel"
and Eqvt': "eqvt Rel''"
and Trans: "Rel O Rel' ⊆ Rel''"
and Sim: "⋀P Q. (P, Q) ∈ Rel ⟹ P ↝⇧^<Rel> Q"
and PRelQ: "(P, Q) ∈ Rel"
shows "P ↝⇧^<Rel''> R"
proof -
from PRelQ have PSimQ: "P ↝⇧^<Rel> Q" by(rule Sim)
from Eqvt' show ?thesis
proof(induct rule: simCasesCont[of _ "(P, Q)"])
case(Bound R' a x)
have RTrans: "R ⟼ a<νx> ≺ R'" by fact
have "x ♯ (P, Q)" by fact
hence xFreshP: "x ♯ P" and xFreshQ: "x ♯ Q" by(simp add: fresh_prod)+
from QSimR RTrans xFreshQ have "∃Q'. Q ⟹⇩l⇧^a<νx> ≺ Q' ∧ (Q', R') ∈ Rel'"
by(rule simE)
then obtain Q' where QTrans: "Q ⟹⇩l⇧^a<νx> ≺ Q'" and Q'RelR': "(Q', R') ∈ Rel'" by blast
from PSimQ Sim Eqvt PRelQ QTrans xFreshP have "∃P'. P ⟹⇩l⇧^a<νx> ≺ P' ∧ (P', Q') ∈ Rel"
by(rule simE2)
then obtain P' where PTrans: "P ⟹⇩l⇧^a<νx> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel" by blast
moreover from P'RelQ' Q'RelR' Trans have "(P', R') ∈ Rel''" by blast
ultimately show ?case by blast
next
case(Input R' a x)
have RTrans: "R ⟼ a<x> ≺ R'" by fact
have "x ♯ (P, Q)" by fact
hence xFreshP: "x ♯ P" and xFreshQ: "x ♯ Q" by(simp add: fresh_prod)+
from QSimR RTrans xFreshQ obtain Q'' where "∀u. ∃Q'. Q ⟹⇩lu in Q''→a<x> ≺ Q' ∧ (Q', R'[x::=u]) ∈ Rel'"
by(blast dest: simE)
hence "∃Q'''. Q ⟹⇩τ Q''' ∧ Q'''⟼a<x> ≺ Q'' ∧ (∀u. ∃Q'. Q''[x::=u]⟹⇩τ Q' ∧ (Q', R'[x::=u]) ∈ Rel')"
by(simp add: inputTransition_def, blast)
then obtain Q''' where QChain: "Q ⟹⇩τ Q'''"
and Q'''Trans: "Q''' ⟼a<x> ≺ Q''"
and L1: "∀u. ∃Q'. Q''[x::=u]⟹⇩τ Q' ∧ (Q', R'[x::=u]) ∈ Rel'"
by blast
from QChain PRelQ Sim have "∃P'''. P ⟹⇩τ P''' ∧ (P''', Q''') ∈ Rel"
by(rule weakSimTauChain)
then obtain P''' where PChain: "P ⟹⇩τ P'''" and P'''RelQ''': "(P''', Q''') ∈ Rel" by blast
from PChain xFreshP have xFreshP''': "x ♯ P'''" by(rule freshChain)
from P'''RelQ''' have "P''' ↝⇧^<Rel> Q'''" by(rule Sim)
hence "∃P''''. ∀u. ∃P''. P''' ⟹⇩lu in P''''→a<x> ≺ P'' ∧ (P'', Q''[x::=u]) ∈ Rel" using Q'''Trans xFreshP'''
by(rule simE)
then obtain P'''' where L2: "∀u. ∃P''. P''' ⟹⇩lu in P''''→a<x> ≺ P'' ∧ (P'', Q''[x::=u]) ∈ Rel"
by blast
have "∀u. ∃P' Q'. P ⟹⇩lu in P''''→a<x> ≺ P' ∧ (P', R'[x::=u]) ∈ Rel''"
proof(rule allI)
fix u
from L1 obtain Q' where Q''Chain: "Q''[x::=u] ⟹⇩τ Q'" and Q'RelR': "(Q', R'[x::=u]) ∈ Rel'"
by blast
from L2 obtain P'' where P'''Trans: "P''' ⟹⇩lu in P''''→a<x> ≺ P''"
and P''RelQ'': "(P'', Q''[x::=u]) ∈ Rel"
by blast
from P''RelQ'' have "P'' ↝⇧^<Rel> Q''[x::=u]" by(rule Sim)
have "∃P'. P'' ⟹⇩τ P' ∧ (P', Q') ∈ Rel" using Q''Chain P''RelQ'' Sim
by(rule weakSimTauChain)
then obtain P' where P''Chain: "P'' ⟹⇩τ P'" and P'RelQ': "(P', Q') ∈ Rel" by blast
from PChain P'''Trans P''Chain have "P ⟹⇩lu in P''''→a<x> ≺ P'"
by(blast dest: Weak_Late_Step_Semantics.chainTransitionAppend)
moreover from P'RelQ' Q'RelR' have "(P', R'[x::=u]) ∈ Rel''" by(insert Trans, auto)
ultimately show "∃P' Q'. P ⟹⇩lu in P''''→a<x> ≺ P' ∧ (P', R'[x::=u]) ∈ Rel''" by blast
qed
thus ?case by force
next
case(Free R' α)
have RTrans: "R ⟼ α ≺ R'" by fact
with QSimR have "∃Q'. Q ⟹⇩l⇧^α ≺ Q' ∧ (Q', R') ∈ Rel'" by(rule simE)
then obtain Q' where QTrans: "Q ⟹⇩l⇧^α ≺ Q'" and Q'RelR': "(Q', R') ∈ Rel'" by blast
from PSimQ Sim Eqvt PRelQ QTrans have "∃P'. P ⟹⇩l⇧^α ≺ P' ∧ (P', Q') ∈ Rel" by(rule simE2)
then obtain P' where PTrans: "P ⟹⇩l⇧^α ≺ P'" and P'RelQ': "(P', Q') ∈ Rel" by blast
from P'RelQ' Q'RelR' Trans have "(P', R') ∈ Rel''" by blast
with PTrans show "∃P'. P ⟹⇩l⇧^α ≺ P' ∧ (P', R') ∈ Rel''" by blast
qed
qed
lemma strongSimWeakSim:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
assumes PSimQ: "P ↝[Rel] Q"
shows "P ↝⇧^<Rel> Q"
proof(induct rule: simCases)
case(Bound Q' a x)
have "Q ⟼a<νx> ≺ Q'" and "x ♯ P" by fact+
with PSimQ obtain P' where PTrans: "P ⟼a<νx> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(force dest: Strong_Late_Sim.simE simp add: derivative_def)
from PTrans have "P ⟹⇩l⇧^a<νx> ≺ P'"
by(force intro: Weak_Late_Step_Semantics.singleActionChain simp add: weakTransition_def)
with P'RelQ' show ?case by blast
next
case(Input Q' a x)
assume "Q ⟼a<x> ≺ Q'" and "x ♯ P"
with PSimQ obtain P' where PTrans: "P ⟼a<x> ≺ P'" and PDer: "derivative P' Q' (InputS a) x Rel"
by(blast dest: Strong_Late_Sim.simE)
have "∀u. ∃P''. P ⟹⇩lu in P'→a<x> ≺ P'' ∧ (P'', Q'[x::=u]) ∈ Rel"
proof(rule allI)
fix u
from PTrans have "P ⟹⇩lu in P'→a<x> ≺ P'[x::=u]" by(blast intro: Weak_Late_Step_Semantics.singleActionChain)
moreover from PDer have "(P'[x::=u], Q'[x::=u]) ∈ Rel" by(force simp add: derivative_def)
ultimately show "∃P''. P ⟹⇩lu in P'→a<x> ≺ P'' ∧ (P'', Q'[x::=u]) ∈ Rel" by auto
qed
thus ?case by blast
next
case(Free Q' α)
have "Q ⟼α ≺ Q'" by fact
with PSimQ obtain P' where PTrans: "P ⟼α ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: Strong_Late_Sim.simE)
from PTrans have "P ⟹⇩l⇧^α ≺ P'" by(rule Weak_Late_Semantics.singleActionChain)
with P'RelQ' show ?case by blast
qed
lemma strongAppend:
fixes P :: pi
and Q :: pi
and R :: pi
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
and Rel'' :: "(pi × pi) set"
assumes PSimQ: "P ↝⇧^<Rel> Q"
and QSimR: "Q ↝[Rel'] R"
and Eqvt'': "eqvt Rel''"
and Trans: "Rel O Rel' ⊆ Rel''"
shows "P ↝⇧^<Rel''> R"
proof -
from Eqvt'' show ?thesis
proof(induct rule: simCasesCont[of _ "(P, Q)"])
case(Bound R' a x)
have "x ♯ (P, Q)" by fact
hence xFreshP: "x ♯ P" and xFreshQ: "x ♯ Q" by(simp add: fresh_prod)+
have RTrans: "R ⟼a<νx> ≺ R'" by fact
from xFreshQ QSimR RTrans obtain Q' where QTrans: "Q ⟼a<νx> ≺ Q'"
and Q'Rel'R': "(Q', R') ∈ Rel'"
by(force dest: Strong_Late_Sim.simE simp add: derivative_def)
with PSimQ QTrans xFreshP have "∃P'. P ⟹⇩l⇧^ a<νx> ≺ P' ∧ (P', Q') ∈ Rel"
by(blast intro: simE)
then obtain P' where PTrans: "P ⟹⇩l⇧^ a<νx> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel" by blast
moreover from P'RelQ' Q'Rel'R' Trans have "(P', R') ∈ Rel''" by blast
ultimately show ?case by blast
next
case(Input R' a x)
have RTrans: "R ⟼ a<x> ≺ R'" by fact
have "x ♯ (P, Q)" by fact
hence xFreshP: "x ♯ P" and xFreshQ: "x ♯ Q" by(simp add: fresh_prod)+
from QSimR RTrans xFreshQ obtain Q' where QTrans: "Q ⟼a<x> ≺ Q'" and Q'Der: "derivative Q' R' (InputS a) x Rel'"
by(blast dest: Strong_Late_Sim.simE)
from QTrans PSimQ xFreshP obtain P'' where L2: "∀u. ∃P'. P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel"
by(blast dest: simE)
have "∀u. ∃P'. P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', R'[x::=u]) ∈ Rel''"
proof(rule allI)
fix u
from L2 obtain P' where PTrans: "P ⟹⇩lu in P''→a<x> ≺ P'"
and P'RelQ': "(P', Q'[x::=u]) ∈ Rel"
by blast
moreover from Q'Der have "(Q'[x::=u], R'[x::=u]) ∈ Rel'" by(simp add: derivative_def)
ultimately show "∃P'. P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', R'[x::=u]) ∈ Rel''" using Trans by blast
qed
thus ?case by force
next
case(Free R' α)
have RTrans: "R ⟼ α ≺ R'" by fact
with QSimR obtain Q' where QTrans: "Q ⟼α ≺ Q'" and Q'RelR': "(Q', R') ∈ Rel'"
by(blast dest: Strong_Late_Sim.simE)
from PSimQ QTrans have "∃P'. P ⟹⇩l⇧^ α ≺ P' ∧ (P', Q') ∈ Rel"
by(blast intro: simE)
then obtain P' where PTrans: "P ⟹⇩l⇧^ α ≺ P'" and P'RelQ': "(P', Q') ∈ Rel" by blast
from P'RelQ' Q'RelR' Trans have "(P', R') ∈ Rel''" by blast
with PTrans show ?case by blast
qed
qed
end
Theory Weak_Late_Bisim
theory Weak_Late_Bisim
imports Weak_Late_Sim Strong_Late_Bisim
begin
lemma monoAux: "A ⊆ B ⟹ P ↝⇧^<A> Q ⟶ P ↝⇧^<B> Q"
by(auto intro: Weak_Late_Sim.monotonic)
coinductive_set weakBisim :: "(pi × pi) set"
where
step: "⟦P ↝⇧^<weakBisim> Q; (Q, P) ∈ weakBisim⟧ ⟹ (P, Q) ∈ weakBisim"
monos monoAux
abbreviation
"weakBisimJudge" (infixr "≈" 65) where "P ≈ Q ≡ (P, Q) ∈ weakBisim"
lemma weakBisimCoinductAux[case_names weakBisim, case_conclusion weakBisim step, consumes 1]:
assumes p: "(P, Q) ∈ X"
and step: "⋀P Q. (P, Q) ∈ X ⟹ P ↝⇧^<(X ∪ weakBisim)> Q ∧ ((Q, P) ∈ X ∨ Q ≈ P)"
shows "P ≈ Q"
proof -
have aux: "X ∪ weakBisim = {(P, Q). (P, Q) ∈ X ∨ P ≈ Q}" by blast
from p show ?thesis
by(coinduct, force dest: step simp add: aux)
qed
lemma weakBisimCoinduct[consumes 1, case_names cSim cSym]:
fixes P :: pi
and Q :: pi
assumes "(P, Q) ∈ X"
and "⋀P Q. (P, Q) ∈ X ⟹ P ↝⇧^<(X ∪ weakBisim)> Q"
and "⋀P Q. (P, Q) ∈ X ⟹ (Q, P) ∈ X"
shows "P ≈ Q"
using assms
by(coinduct rule: weakBisimCoinductAux) auto
lemma weak_coinduct[case_names weakBisim, case_conclusion weakBisim step, consumes 1]:
assumes p: "(P, Q) ∈ X"
and step: "⋀P Q. (P, Q) ∈ X ⟹ P ↝⇧^<X> Q ∧ (Q, P) ∈ X"
shows "P ≈ Q"
using p
proof(coinduct rule: weakBisimCoinductAux)
case (weakBisim P Q)
from step[OF this] show ?case using Weak_Late_Sim.monotonic by blast
qed
lemma weakBisimWeakCoinduct[consumes 1, case_names cSim cSym]:
fixes P :: pi
and Q :: pi
assumes "(P, Q) ∈ X"
and "⋀P Q. (P, Q) ∈ X ⟹ P ↝⇧^<X> Q"
and "⋀P Q. (P, Q) ∈ X ⟹ (Q, P) ∈ X"
shows "P ≈ Q"
using assms
by(coinduct rule: weak_coinduct) auto
lemma monotonic: "mono(λp x1 x2. ∃P Q. x1 = P ∧ x2 = Q ∧ P ↝⇧^<{(xa, x). p xa x}> Q ∧ Q ↝⇧^<{(xa, x). p xa x}> P)"
by(auto intro: monoI Weak_Late_Sim.monotonic)
lemma unfoldE:
fixes P :: pi
and Q :: pi
assumes "P ≈ Q"
shows "P ↝⇧^<weakBisim> Q"
and "Q ≈ P"
using assms
by(auto intro: weakBisim.cases)
lemma unfoldI:
fixes P :: pi
and Q :: pi
assumes "P ↝⇧^<weakBisim> Q"
and "Q ≈ P"
shows "P ≈ Q"
using assms
by(auto intro: weakBisim.cases)
lemma eqvt:
shows "eqvt weakBisim"
proof(auto simp add: eqvt_def)
let ?X = "{x. ∃P Q (perm::name prm). P ≈ Q ∧ x = (perm ∙ P, perm ∙ Q)}"
fix P Q
fix perm::"name prm"
assume PBiSimQ: "P ≈ Q"
hence "(perm ∙ P, perm ∙ Q) ∈ ?X" by blast
moreover have "⋀P Q perm::name prm. ⟦P ↝⇧^<weakBisim> Q⟧ ⟹ (perm ∙ P) ↝⇧^<?X> (perm ∙ Q)"
proof -
fix P Q
fix perm::"name prm"
assume "P ↝⇧^<weakBisim> Q"
moreover have "weakBisim ⊆ ?X"
proof(auto)
fix P Q
assume "P ≈ Q"
moreover have "P = ([]::name prm) ∙ P" and "Q = ([]::name prm) ∙ Q" by auto
ultimately show "∃P' Q'. P' ≈ Q' ∧ (∃(perm::name prm). P = perm ∙ P' ∧ Q = perm ∙ Q')"
by blast
qed
moreover have "eqvt ?X"
proof(auto simp add: eqvt_def)
fix P Q
fix perm1::"name prm"
fix perm2::"name prm"
assume "P ≈ Q"
moreover have "perm1 ∙ perm2 ∙ P = (perm1 @ perm2) ∙ P" by(simp add: pt2[OF pt_name_inst])
moreover have "perm1 ∙ perm2 ∙ Q = (perm1 @ perm2) ∙ Q" by(simp add: pt2[OF pt_name_inst])
ultimately show "∃P' Q'. P' ≈ Q' ∧ (∃(perm::name prm). perm1 ∙ perm2 ∙ P = perm ∙ P' ∧
perm1 ∙ perm2 ∙ Q = perm ∙ Q')"
by blast
qed
ultimately show "(perm ∙ P) ↝⇧^<?X> (perm ∙ Q)"
by(rule Weak_Late_Sim.eqvtI)
qed
ultimately show "(perm ∙ P) ≈ (perm ∙ Q)" by(coinduct rule: weak_coinduct, blast dest: unfoldE)
qed
lemma eqvtI:
fixes P :: pi
and Q :: pi
and perm :: "name prm"
assumes "P ≈ Q"
shows "(perm ∙ P) ≈ (perm ∙ Q)"
using assms
by(rule eqvtRelI[OF eqvt])
lemma weakBisimEqvt[simp]:
shows "eqvt weakBisim"
by(auto simp add: eqvt_def eqvtI)
lemma strongBisimWeakBisim:
fixes P :: pi
and Q :: pi
assumes PSimQ: "P ∼ Q"
shows "P ≈ Q"
proof -
have "⋀P Q. P ↝[bisim] Q ⟹ P ↝⇧^<(bisim ∪ weakBisim)> Q"
proof -
fix P Q
assume "P ↝[bisim] Q"
hence "P ↝⇧^<bisim> Q" by(rule strongSimWeakSim)
thus "P ↝⇧^<(bisim ∪ weakBisim)> Q"
by(blast intro: Weak_Late_Sim.monotonic)
qed
with PSimQ show ?thesis
by(coinduct rule: weakBisimCoinductAux, force dest: Strong_Late_Bisim.bisimE symmetric)
qed
lemma reflexive:
fixes P :: pi
shows "P ≈ P"
proof -
have "(P, P) ∈ Id" by simp
then show ?thesis
proof (coinduct rule: weak_coinduct)
case (weakBisim P Q)
have "(P, Q) ∈ Id" by fact
thus ?case by(auto intro: Weak_Late_Sim.reflexive)
qed
qed
lemma symmetric:
fixes P :: pi
and Q :: pi
assumes "P ≈ Q"
shows "Q ≈ P"
using assms
by(auto dest: unfoldE intro: unfoldI)
lemma transitive:
fixes P :: pi
and Q :: pi
and R :: pi
assumes PBiSimQ: "P ≈ Q"
and QBiSimR: "Q ≈ R"
shows "P ≈ R"
proof -
let ?X = "weakBisim O weakBisim"
from assms have "(P, R) ∈ ?X" by blast
moreover have "⋀P Q R. ⟦Q ↝⇧^<weakBisim> R; P ≈ Q⟧ ⟹
P ↝⇧^<(?X ∪ weakBisim)> R"
proof -
fix P Q R
assume PBiSimQ: "P ≈ Q"
assume "Q ↝⇧^<weakBisim> R"
moreover have "eqvt weakBisim" by(rule eqvt)
moreover from eqvt have "eqvt (?X ∪ weakBisim)" by(auto simp add: eqvtTrans)
moreover have "weakBisim O weakBisim ⊆ ?X ∪ weakBisim" by auto
moreover have "⋀P Q. P ≈ Q ⟹ P ↝⇧^<weakBisim> Q" by(rule unfoldE)
ultimately show "P ↝⇧^<(?X ∪ weakBisim)> R" using PBiSimQ
by(rule Weak_Late_Sim.transitive)
qed
ultimately show ?thesis
apply(coinduct rule: weakBisimCoinduct, auto)
by(blast dest: unfoldE symmetric)+
qed
lemma transitive_coinduct_weak[case_names WeakBisimEarly, case_conclusion WeakBisimEarly step, consumes 2]:
assumes p: "(P, Q) ∈ X"
and Eqvt: "eqvt X"
and step: "⋀P Q. (P, Q) ∈ X ⟹ P ↝⇧^<(bisim O X O bisim)> Q ∧ (Q, P) ∈ X"
shows "P ≈ Q"
proof -
let ?X = "bisim O X O bisim"
have Sim: "⋀P P' Q' Q. ⟦P ∼ P'; P'↝⇧^<?X> Q'; Q' ↝[bisim] Q⟧ ⟹
P ↝⇧^<?X> Q"
proof -
fix P P' Q' Q
assume PBisimP': "P ∼ P'"
assume P'SimQ': "P' ↝⇧^<?X> Q'"
assume Q'SimQ: "Q' ↝[bisim] Q"
show "P ↝⇧^<?X> Q"
proof -
have "P' ↝⇧^<?X> Q"
proof -
have "?X O bisim ⊆ ?X" by(blast intro: Strong_Late_Bisim.transitive)
moreover from Strong_Late_Bisim.bisimEqvt Eqvt have "eqvt ?X" by blast
ultimately show ?thesis using P'SimQ' Q'SimQ by(blast intro: strongAppend)
qed
moreover have "eqvt bisim" by(rule Strong_Late_Bisim.bisimEqvt)
moreover from Strong_Late_Bisim.bisimEqvt Eqvt have "eqvt ?X" by blast
moreover have "bisim O ?X ⊆ ?X" by(blast intro: Strong_Late_Bisim.transitive)
moreover have "⋀P Q. P ∼ Q ⟹ P ↝⇧^<bisim> Q" by(blast dest: Strong_Late_Bisim.bisimE strongSimWeakSim)
ultimately show ?thesis using PBisimP' by(rule Weak_Late_Sim.transitive)
qed
qed
from p have "(P, Q) ∈ ?X" by(blast intro: Strong_Late_Bisim.reflexive)
moreover from step Sim have "⋀P Q. (P, Q) ∈ ?X ⟹ P ↝⇧^<?X> Q ∧ (Q, P) ∈ ?X"
by(blast dest: Strong_Late_Bisim.bisimE Strong_Late_Bisim.symmetric)
ultimately show ?thesis by(rule weak_coinduct)
qed
lemma weakBisimTransitiveCoinduct[case_names cSim cSym, consumes 2]:
assumes p: "(P, Q) ∈ X"
and Eqvt: "eqvt X"
and rSim: "⋀P Q. (P, Q) ∈ X ⟹ P ↝⇧^<(bisim O X O bisim)> Q"
and rSym: "⋀P Q. (P, Q) ∈ X ⟹ (Q, P) ∈ X"
shows "P ≈ Q"
using assms
by(coinduct rule: transitive_coinduct_weak) auto
end
Theory Weak_Late_Step_Sim
theory Weak_Late_Step_Sim
imports Weak_Late_Step_Semantics Weak_Late_Sim Strong_Late_Sim
begin
definition weakStepSimAct :: "pi ⇒ residual ⇒ ('a::fs_name) ⇒ (pi × pi) set ⇒ bool" where
"weakStepSimAct P Rs C Rel ≡ (∀Q' a x. Rs = a<νx> ≺ Q' ⟶ x ♯ C ⟶ (∃P' . P ⟹⇩la<νx> ≺ P' ∧ (P', Q') ∈ Rel)) ∧
(∀Q' a x. Rs = a<x> ≺ Q' ⟶ x ♯ C ⟶ (∃P''. ∀u. ∃P'. P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel)) ∧
(∀Q' α. Rs = α ≺ Q' ⟶ (∃P'. P ⟹⇩lα ≺ P' ∧ (P', Q') ∈ Rel))"
definition weakStepSimAux :: "pi ⇒ (pi × pi) set ⇒ pi ⇒ bool" where
"weakStepSimAux P Rel Q ≡ (∀Q' a x. (Q ⟼a<νx> ≺ Q' ∧ x ♯ P) ⟶ (∃P' . P ⟹⇩la<νx> ≺ P' ∧ (P', Q') ∈ Rel)) ∧
(∀Q' a x. (Q ⟼a<x> ≺ Q' ∧ x ♯ P) ⟶ (∃P''. ∀u. ∃P'. P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel)) ∧
(∀Q' α. Q ⟼α ≺ Q' ⟶ (∃P'. P ⟹⇩lα ≺ P' ∧ (P', Q') ∈ Rel))"
definition weakStepSim :: "pi ⇒ (pi × pi) set ⇒ pi ⇒ bool" ("_ ↝<_> _" [80, 80, 80] 80) where
"P ↝<Rel> Q ≡ (∀Rs. Q ⟼ Rs ⟶ weakStepSimAct P Rs P Rel)"
lemmas weakStepSimDef = weakStepSimAct_def weakStepSim_def
lemma "weakStepSimAux P Rel Q = weakStepSim P Rel Q"
by(auto simp add: weakStepSimDef weakStepSimAux_def)
lemma monotonic:
fixes A :: "(pi × pi) set"
and B :: "(pi × pi) set"
and P :: pi
and P' :: pi
assumes "P ↝<A> P'"
and "A ⊆ B"
shows "P ↝<B> P'"
using assms
apply(auto simp add: weakStepSimDef)
apply blast
apply(erule_tac x="a<x> ≺ Q'" in allE)
apply(clarsimp)
apply(rotate_tac 4)
apply(erule_tac x=Q' in allE)
apply(erule_tac x=a in allE)
apply(erule_tac x=x in allE)
by blast+
lemma simCasesCont[consumes 1, case_names Bound Input Free]:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and C :: "'a::fs_name"
assumes Eqvt: "eqvt Rel"
and Bound: "⋀Q' a x. ⟦x ♯ C; Q ⟼a<νx> ≺ Q'⟧ ⟹ ∃P'. P ⟹⇩la<νx> ≺ P' ∧ (P', Q') ∈ Rel"
and Input: "⋀Q' a x. ⟦x ♯ C; Q ⟼a<x> ≺ Q'⟧ ⟹ ∃P''. ∀u. ∃P'. P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel"
and Free: "⋀Q' α. Q ⟼ α ≺ Q' ⟹ (∃P'. P ⟹⇩l α ≺ P' ∧ (P', Q') ∈ Rel)"
shows "P ↝<Rel> Q"
using Free
proof(auto simp add: weakStepSimDef)
fix Q' a x
assume xFreshP: "(x::name) ♯ P"
assume Trans: "Q ⟼ a<νx> ≺ Q'"
have "∃c::name. c ♯ (P, Q', x, C)" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshP: "c ♯ P" and cFreshQ': "c ♯ Q'" and cFreshC: "c ♯ C"
and cineqx: "c ≠ x"
by(force simp add: fresh_prod)
from Trans cFreshQ' have "Q ⟼ a<νc> ≺ ([(x, c)] ∙ Q')" by(simp add: alphaBoundResidual)
with cFreshC have "∃P'. P ⟹⇩l a<νc> ≺ P' ∧ (P', [(x, c)] ∙ Q') ∈ Rel"
by(rule Bound)
then obtain P' where PTrans: "P ⟹⇩l a<νc> ≺ P'" and P'RelQ': "(P', [(x, c)] ∙ Q') ∈ Rel"
by blast
from PTrans xFreshP cineqx have xFreshP': "x ♯ P'" by(force dest: Weak_Late_Step_Semantics.freshTransition)
with PTrans have "P ⟹⇩l a<νx> ≺ ([(x, c)] ∙ P')" by(simp add: alphaBoundResidual name_swap)
moreover have "([(x, c)] ∙ P', Q') ∈ Rel" (is "?goal")
proof -
from Eqvt P'RelQ' have "([(x, c)] ∙ P', [(x, c)] ∙ [(x, c)] ∙ Q') ∈ Rel"
by(rule eqvtRelI)
with cineqx show ?goal by(simp add: name_calc)
qed
ultimately show "∃P'. P ⟹⇩la<νx> ≺ P' ∧ (P', Q') ∈ Rel" by blast
next
fix Q' a x u
assume QTrans: "Q ⟼a<x> ≺ (Q'::pi)"
and xFreshP: "x ♯ P"
have "∃c::name. c ♯ (P, Q', C, x)" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshP: "c ♯ P" and cFreshQ': "c ♯ Q'" and cFreshC: "c ♯ C"
and cineqx: "c ≠ x"
by(force simp add: fresh_prod)
from QTrans cFreshQ' have "Q ⟼a<c> ≺ ([(x, c)] ∙ Q')" by(simp add: alphaBoundResidual)
with cFreshC have "∃P''. ∀u. ∃P'. P ⟹⇩lu in P''→a<c> ≺ P' ∧ (P', ([(x, c)] ∙ Q')[c::=u]) ∈ Rel"
by(rule Input)
then obtain P'' where L1: "∀u. ∃P'. P ⟹⇩lu in P''→a<c> ≺ P' ∧ (P', ([(x, c)] ∙ Q')[c::=u]) ∈ Rel" by blast
have "∀u. ∃P'. P ⟹⇩lu in ([(c, x)] ∙ P'')→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel"
proof(auto)
fix u
from L1 obtain P' where PTrans: "P ⟹⇩lu in P''→a<c> ≺ P'" and P'RelQ': "(P', ([(x, c)] ∙ Q')[c::=u]) ∈ Rel"
by blast
from PTrans xFreshP have "P ⟹⇩lu in ([(c, x)] ∙ P'')→a<x> ≺ P'" by(rule alphaInput)
moreover from P'RelQ' cFreshQ' have "(P', Q'[x::=u]) ∈ Rel" by(simp add: renaming[THEN sym] name_swap)
ultimately show "∃P'. P ⟹⇩lu in ([(c, x)] ∙ P'')→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel" by blast
qed
thus "∃P''. ∀u. ∃P'. P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel" by blast
qed
lemma simCases[consumes 0, case_names Bound Input Free]:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and C :: "'a::fs_name"
assumes Bound: "⋀Q' a x. ⟦Q ⟼a<νx> ≺ Q'; x ♯ P⟧ ⟹ ∃P'. P ⟹⇩la<νx> ≺ P' ∧ (P', Q') ∈ Rel"
and Input: "⋀Q' a x. ⟦Q ⟼a<x> ≺ Q'; x ♯ P⟧ ⟹ ∃P''. ∀u. ∃P'. P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel"
and Free: "⋀Q' α. Q ⟼ α ≺ Q' ⟹ (∃P'. P ⟹⇩l α ≺ P' ∧ (P', Q') ∈ Rel)"
shows "P ↝<Rel> Q"
using assms
by(auto simp add: weakStepSimDef)
lemma simActBoundCases[consumes 1, case_names Input BoundOutput]:
fixes P :: pi
and a :: subject
and x :: name
and Q' :: pi
and C :: "'a::fs_name"
and Rel :: "(pi × pi) set"
assumes EqvtRel: "eqvt Rel"
and DerInput: "⋀b. a = InputS b ⟹ (∃P''. ∀u. ∃P'. (P ⟹⇩lu in P''→b<x> ≺ P') ∧ (P', Q'[x::=u]) ∈ Rel)"
and DerBoundOutput: "⋀b. a = BoundOutputS b ⟹ (∃P'. (P ⟹⇩lb<νx> ≺ P') ∧ (P', Q') ∈ Rel)"
shows "weakStepSimAct P (a«x» ≺ Q') P Rel"
proof(simp add: weakStepSimAct_def fresh_prod, auto)
fix Q'' b y
assume Eq: "a«x» ≺ Q' = b<νy> ≺ Q''"
assume yFreshP: "y ♯ P"
from Eq have "a = BoundOutputS b" by(simp add: residual.inject)
from yFreshP DerBoundOutput[OF this] Eq show "∃P'. P ⟹⇩lb<νy> ≺ P' ∧ (P', Q'') ∈ Rel"
proof(cases "x=y", auto simp add: residual.inject name_abs_eq)
fix P'
assume PTrans: "P ⟹⇩lb<νx> ≺ P'"
assume P'RelQ': "(P', ([(x, y)] ∙ Q'')) ∈ Rel"
assume xineqy: "x ≠ y"
with PTrans yFreshP have yFreshP': "y ♯ P'"
by(force intro: Weak_Late_Step_Semantics.freshTransition)
hence "b<νx> ≺ P' = b<νy> ≺ [(x, y)] ∙ P'" by(rule alphaBoundResidual)
moreover have "([(x, y)] ∙ P', Q'') ∈ Rel"
proof -
from EqvtRel P'RelQ' have "([(x, y)] ∙ P', [(x, y)] ∙ ([(x, y)] ∙ Q''))∈ Rel"
by(rule eqvtRelI)
thus ?thesis by(simp add: name_calc)
qed
ultimately show "∃P'. P ⟹⇩lb<νy> ≺ P' ∧ (P', Q'') ∈ Rel" using PTrans by auto
qed
next
fix Q'' b y u
assume Eq: "a«x» ≺ Q' = b<y> ≺ Q''"
assume yFreshP: "y ♯ P"
from Eq have "a = InputS b" by(simp add: residual.inject)
from DerInput[OF this] obtain P'' where L1: "∀u. ∃P'. P ⟹⇩lu in P''→b<x> ≺ P' ∧
(P', Q'[x::=u]) ∈ Rel"
by blast
have "∀u. ∃P'. P ⟹⇩lu in ([(x, y)] ∙ P'')→b<y> ≺ P' ∧ (P', Q''[y::=u]) ∈ Rel"
proof(rule allI)
fix u
from L1 Eq show "∃P'. P ⟹⇩lu in ([(x, y)] ∙ P'')→b<y> ≺ P' ∧ (P', Q''[y::=u]) ∈ Rel"
proof(cases "x=y", auto simp add: residual.inject name_abs_eq)
assume Der: "∀u. ∃P'. P ⟹⇩lu in P''→b<x> ≺ P' ∧ (P', ([(x, y)] ∙ Q'')[x::=u]) ∈ Rel"
assume xFreshQ'': "x ♯ Q''"
from Der obtain P' where PTrans: "P ⟹⇩lu in P''→b<x> ≺ P'"
and P'RelQ': "(P', ([(x, y)] ∙ Q'')[x::=u]) ∈ Rel"
by force
from PTrans yFreshP have "P ⟹⇩lu in ([(x, y)] ∙ P'')→b<y> ≺ P'" by(rule alphaInput)
moreover from xFreshQ'' P'RelQ' have "(P', Q''[y::=u]) ∈ Rel"
by(simp add: renaming)
ultimately show ?thesis by force
qed
qed
thus "∃P''. ∀u. ∃P'. P ⟹⇩lu in P''→b<y> ≺ P' ∧ (P', Q''[y::=u]) ∈ Rel"
by blast
qed
lemma simActFreeCases[consumes 0, case_names Free]:
fixes P :: pi
and α :: freeRes
and C :: "'a::fs_name"
and Rel :: "(pi × pi) set"
assumes Der: "∃P'. (P ⟹⇩lα ≺ P') ∧ (P', Q') ∈ Rel"
shows "weakStepSimAct P (α ≺ Q') P Rel"
using assms
by(simp add: weakStepSimAct_def residual.inject)
lemma simE:
fixes P :: pi
and Rel :: "(pi × pi) set"
and Q :: pi
and a :: name
and x :: name
and u :: name
and Q' :: pi
assumes "P ↝<Rel> Q"
shows "Q ⟼a<νx> ≺ Q' ⟹ x ♯ P ⟹ ∃P'. P ⟹⇩la<νx> ≺ P' ∧ (P', Q') ∈ Rel"
and "Q ⟼a<x> ≺ Q' ⟹ x ♯ P ⟹ ∃P''. ∀u. ∃P'. P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel"
and "Q ⟼α ≺ Q' ⟹ (∃P'. P ⟹⇩lα ≺ P' ∧ (P', Q') ∈ Rel)"
using assms by(simp add: weakStepSimDef)+
lemma weakSimTauChain:
fixes P :: pi
and Rel :: "(pi × pi) set"
and Q :: pi
and Q' :: pi
assumes QChain: "Q ⟹⇩τ Q'"
and PRelQ: "(P, Q) ∈ Rel"
and Sim: "⋀P Q. (P, Q) ∈ Rel ⟹ P ↝<Rel> Q"
shows "∃P'. P ⟹⇩τ P' ∧ (P', Q') ∈ Rel"
proof -
from QChain show ?thesis
proof(induct rule: tauChainInduct)
case id
have "P ⟹⇩τ P" by simp
with PRelQ show ?case by blast
next
case(ih Q' Q'')
have IH: "∃P'. P ⟹⇩τ P' ∧ (P', Q') ∈ Rel" by fact
then obtain P' where PChain: "P ⟹⇩τ P'" and P'RelQ': "(P', Q') ∈ Rel" by blast
from P'RelQ' have "P' ↝<Rel> Q'" by(rule Sim)
moreover have Q'Trans: "Q' ⟼τ ≺ Q''" by fact
ultimately have "∃P''. P' ⟹⇩lτ ≺ P'' ∧ (P'', Q'') ∈ Rel" by(rule simE)
then obtain P'' where P'Trans: "P' ⟹⇩lτ ≺ P''" and P''RelQ'': "(P'', Q'') ∈ Rel" by blast
from P'Trans have "P' ⟹⇩τ P''" by(rule Weak_Late_Step_Semantics.tauTransitionChain)
with PChain have "P ⟹⇩τ P''" by auto
with P''RelQ'' show ?case by blast
qed
qed
lemma strongSimWeakEqSim:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
assumes PSimQ: "P ↝[Rel] Q"
shows "P ↝<Rel> Q"
proof(auto simp add: weakStepSimDef)
fix Q' a x
assume "Q ⟼a<νx> ≺ Q'" and "x ♯ P"
with PSimQ have "∃P'. P ⟼a<νx> ≺ P' ∧ derivative P' Q' (BoundOutputS a) x Rel"
by(rule Strong_Late_Sim.simE)
then obtain P' where PTrans: "P ⟼a<νx> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(force simp add: derivative_def)
from PTrans have "P ⟹⇩la<νx> ≺ P'" by(rule Weak_Late_Step_Semantics.singleActionChain)
thus "∃P'. P ⟹⇩la<νx> ≺ P' ∧ (P', Q') ∈ Rel" using P'RelQ' by blast
next
fix Q' a x u
assume "Q ⟼a<x> ≺ Q'" and "x ♯ P"
with PSimQ have L1: "∃P'. P ⟼a<x> ≺ P' ∧ derivative P' Q' (InputS a) x Rel"
by(blast intro: Strong_Late_Sim.simE)
then obtain P' where PTrans: "P ⟼a<x> ≺ P'" and PDer: "derivative P' Q' (InputS a) x Rel"
by blast
have "∀u. ∃P''. P ⟹⇩lu in P'→a<x> ≺ P'' ∧ (P'', Q'[x::=u]) ∈ Rel"
proof(rule allI)
fix u
from PTrans have "P ⟹⇩lu in P'→a<x> ≺ P'[x::=u]" by(blast intro: Weak_Late_Step_Semantics.singleActionChain)
moreover from PDer have "(P'[x::=u], Q'[x::=u]) ∈ Rel" by(force simp add: derivative_def)
ultimately show "∃P''. P ⟹⇩lu in P'→a<x> ≺ P'' ∧ (P'', Q'[x::=u]) ∈ Rel" by auto
qed
thus "∃P''. ∀u. ∃P'. P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel" by blast
next
fix Q' α
assume "Q ⟼α ≺ Q'"
with PSimQ have "∃P'. P ⟼α ≺ P' ∧ (P', Q') ∈ Rel" by(rule Strong_Late_Sim.simE)
then obtain P' where PTrans: "P ⟼α ≺ P'" and P'RelQ': "(P', Q') ∈ Rel" by blast
from PTrans have "P ⟹⇩lα ≺ P'" by(rule Weak_Late_Step_Semantics.singleActionChain)
thus "∃P'. P ⟹⇩lα ≺ P' ∧ (P', Q') ∈ Rel" using P'RelQ' by blast
qed
lemma weakSimWeakEqSim:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
assumes "P ↝<Rel> Q"
shows "P ↝⇧^<Rel> Q"
using assms
by(force simp add: weakStepSimDef simDef weakTransition_def)
lemma eqvtI:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and perm :: "name prm"
assumes Sim: "P ↝<Rel> Q"
and RelRel': "Rel ⊆ Rel'"
and EqvtRel': "eqvt Rel'"
shows "(perm ∙ P) ↝<Rel'> (perm ∙ Q)"
using EqvtRel'
proof(induct rule: simCasesCont[of _ "perm ∙ P"])
case(Bound Q' a x)
have QTrans: "(perm ∙ Q) ⟼ a<νx> ≺ Q'" by fact
have xFreshP: "x ♯ perm ∙ P" by fact
from QTrans have "(rev perm ∙ (perm ∙ Q)) ⟼ rev perm ∙ (a<νx> ≺ Q')"
by(rule eqvts)
hence "Q ⟼ (rev perm ∙ a)<ν(rev perm ∙ x)> ≺ (rev perm ∙ Q')"
by(simp add: name_rev_per)
moreover from xFreshP have "(rev perm ∙ x) ♯ P" by(simp add: name_fresh_left)
ultimately obtain P' where PTrans: "P ⟹⇩l (rev perm ∙ a)<ν(rev perm ∙ x)> ≺ P'"
and P'RelQ': "(P', rev perm ∙ Q') ∈ Rel" using Sim
by(blast dest: simE)
from PTrans have "(perm ∙ P) ⟹⇩l perm ∙ ((rev perm ∙ a)<ν(rev perm ∙ x)> ≺ P')"
by(rule Weak_Late_Step_Semantics.eqvtI)
hence "(perm ∙ P) ⟹⇩l a<νx> ≺ (perm ∙ P')" by(simp add: name_per_rev)
moreover have "(perm ∙ P', Q') ∈ Rel'"
proof -
from P'RelQ' RelRel' have "(P', rev perm ∙ Q') ∈ Rel'" by blast
with EqvtRel' have "(perm ∙ P', perm ∙ (rev perm ∙ Q')) ∈ Rel'"
by(rule eqvtRelI)
thus ?thesis by(simp add: name_per_rev)
qed
ultimately show ?case by blast
next
case(Input Q' a x)
have QTrans: "(perm ∙ Q) ⟼a<x> ≺ Q'" by fact
have xFreshP: "x ♯ perm ∙ P" by fact
from QTrans have "(rev perm ∙ (perm ∙ Q)) ⟼ rev perm ∙ (a<x> ≺ Q')"
by(rule eqvts)
hence "Q ⟼ (rev perm ∙ a)<(rev perm ∙ x)> ≺ (rev perm ∙ Q')"
by(simp add: name_rev_per)
moreover from xFreshP have xFreshP: "(rev perm ∙ x) ♯ P" by(simp add: name_fresh_left)
ultimately obtain P''
where L1: "∀u. ∃P'. P ⟹⇩lu in P''→(rev perm ∙ a)<(rev perm ∙ x)> ≺ P' ∧
(P', (rev perm ∙ Q')[(rev perm ∙ x)::=u]) ∈ Rel" using Sim
by(blast dest: simE)
have "∀u. ∃P'. (perm ∙ P) ⟹⇩lu in (perm ∙ P'')→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel'"
proof(rule allI)
fix u
from L1 obtain P' where PTrans: "P ⟹⇩l(rev perm ∙ u) in P''→(rev perm ∙ a)<(rev perm ∙ x)> ≺ P'"
and P'RelQ': "(P', (rev perm ∙ Q')[(rev perm ∙ x)::=(rev perm ∙ u)]) ∈ Rel" by blast
from PTrans have "(perm ∙ P) ⟹⇩l(perm ∙ (rev perm ∙ u)) in (perm ∙ P'')→(perm ∙ rev perm ∙ a)<(perm ∙ rev perm ∙ x)> ≺ (perm ∙ P')"
by(rule_tac Weak_Late_Step_Semantics.eqvtI, auto)
hence "(perm ∙ P) ⟹⇩lu in (perm ∙ P'')→a<x> ≺ (perm ∙ P')" by(simp add: name_per_rev)
moreover have "(perm ∙ P', Q'[x::=u]) ∈ Rel'"
proof -
from P'RelQ' RelRel' have "(P', (rev perm ∙ Q')[(rev perm ∙ x)::=(rev perm ∙ u)]) ∈ Rel'" by blast
with EqvtRel' have "(perm ∙ P', perm ∙ ((rev perm ∙ Q')[(rev perm ∙ x)::=(rev perm ∙ u)])) ∈ Rel'"
by(rule eqvtRelI)
thus ?thesis by(simp add: name_per_rev eqvt_subs[THEN sym] name_calc)
qed
ultimately show "∃P'. (perm ∙ P) ⟹⇩lu in (perm ∙ P'')→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel'" by blast
qed
thus ?case by blast
next
case(Free Q' α)
have QTrans: "(perm ∙ Q) ⟼ α ≺ Q'" by fact
from QTrans have "(rev perm ∙ (perm ∙ Q)) ⟼ rev perm ∙ (α ≺ Q')"
by(rule eqvts)
hence "Q ⟼ (rev perm ∙ α) ≺ (rev perm ∙ Q')"
by(simp add: name_rev_per)
with Sim obtain P' where PTrans: "P ⟹⇩l (rev perm ∙ α) ≺ P'" and PRel: "(P', (rev perm ∙ Q')) ∈ Rel"
by(blast dest: simE)
from PTrans have "(perm ∙ P) ⟹⇩l perm ∙ ((rev perm ∙ α)≺ P')"
by(rule Weak_Late_Step_Semantics.eqvtI)
hence "(perm ∙ P) ⟹⇩l α ≺ (perm ∙ P')" by(simp add: name_per_rev)
moreover have "((perm ∙ P'), Q') ∈ Rel'"
proof -
from PRel EqvtRel' RelRel' have "((perm ∙ P'), (perm ∙ (rev perm ∙ Q'))) ∈ Rel'"
by(force intro: eqvtRelI)
thus ?thesis by(simp add: name_per_rev)
qed
ultimately show ?case by blast
qed
lemma simE2:
fixes P :: pi
and Rel :: "(pi × pi) set"
and Q :: pi
and a :: name
and x :: name
and Q' :: pi
assumes PSimQ: "P ↝<Rel> Q"
and Sim: "⋀P Q. (P, Q) ∈ Rel ⟹ P ↝⇧^<Rel> Q"
and Eqvt: "eqvt Rel"
and PRelQ: "(P, Q) ∈ Rel"
shows "Q ⟹⇩la<νx> ≺ Q' ⟹ x ♯ P ⟹ ∃P'. P ⟹⇩la<νx> ≺ P' ∧ (P', Q') ∈ Rel"
and "Q ⟹⇩lα ≺ Q' ⟹ ∃P'. P ⟹⇩lα ≺ P' ∧ (P', Q') ∈ Rel"
proof -
assume QTrans: "Q ⟹⇩la<νx> ≺ Q'"
assume xFreshP: "x ♯ P"
have Goal: "⋀P Q a x Q'. ⟦P ↝<Rel> Q; Q ⟹⇩la<νx> ≺ Q'; x ♯ P; x ♯ Q; (P, Q) ∈ Rel⟧ ⟹
∃P'. P ⟹⇩la<νx> ≺ P' ∧ (P', Q') ∈ Rel"
proof -
fix P Q a x Q'
assume PSimQ: "P ↝<Rel> Q"
assume QTrans: "Q ⟹⇩la<νx> ≺ Q'"
assume xFreshP: "x ♯ P"
assume xFreshQ: "x ♯ Q"
assume PRelQ: "(P, Q) ∈ Rel"
from QTrans xFreshQ obtain Q'' Q''' where QChain: "Q ⟹⇩τ Q''"
and Q''Trans: "Q'' ⟼a<νx> ≺ Q'''"
and Q'''Chain: "Q''' ⟹⇩τ Q'"
by(force dest: transitionE simp add: weakTransition_def)
from QChain PRelQ Sim have "∃P''. P ⟹⇩τ P'' ∧ (P'', Q'') ∈ Rel"
by(rule Weak_Late_Sim.weakSimTauChain)
then obtain P'' where PChain: "P ⟹⇩τ P''" and P''RelQ'': "(P'', Q'') ∈ Rel" by blast
from PChain xFreshP have xFreshP'': "x ♯ P''" by(rule freshChain)
from P''RelQ'' have "P'' ↝⇧^<Rel> Q''" by(rule Sim)
hence "∃P'''. P'' ⟹⇩l⇧^a<νx> ≺ P''' ∧ (P''', Q''') ∈ Rel" using Q''Trans xFreshP''
by(rule Weak_Late_Sim.simE)
then obtain P''' where P''Trans: "P'' ⟹⇩la<νx> ≺ P'''" and P'''RelQ''': "(P''', Q''') ∈ Rel"
by(force simp add: weakTransition_def)
have "∃P'. P''' ⟹⇩τ P' ∧ (P', Q') ∈ Rel" using Q'''Chain P'''RelQ''' Sim
by(rule Weak_Late_Sim.weakSimTauChain)
then obtain P' where P'''Chain: "P''' ⟹⇩τ P'" and P'RelQ': "(P', Q') ∈ Rel" by blast
from PChain P''Trans P'''Chain xFreshP'' have "P ⟹⇩la<νx> ≺ P'"
by(blast dest: Weak_Late_Step_Semantics.chainTransitionAppend)
with P'RelQ' show "∃P'. P ⟹⇩l a<νx> ≺ P' ∧ (P', Q') ∈ Rel" by blast
qed
have "∃c::name. c ♯ (Q, Q', P, x)" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshQ: "c ♯ Q" and cFreshQ': "c ♯ Q'" and cFreshP: "c ♯ P"
and xineqc: "x ≠ c"
by(force simp add: fresh_prod)
from QTrans cFreshQ' have "Q ⟹⇩la<νc> ≺ ([(x, c)] ∙ Q')" by(simp add: alphaBoundResidual)
with PSimQ have "∃P'. P ⟹⇩la<νc> ≺ P' ∧ (P', [(x, c)] ∙ Q') ∈ Rel" using cFreshP cFreshQ PRelQ
by(rule Goal)
then obtain P' where PTrans: "P ⟹⇩la<νc> ≺ P'" and P'RelQ': "(P', [(x, c)] ∙ Q') ∈ Rel"
by force
have "P ⟹⇩la<νx> ≺ ([(x, c)] ∙ P')"
proof -
from PTrans xFreshP xineqc have "x ♯ P'" by(rule Weak_Late_Step_Semantics.freshTransition)
with PTrans show ?thesis by(simp add: alphaBoundResidual name_swap)
qed
moreover have "([(x, c)] ∙ P', Q') ∈ Rel"
proof -
from Eqvt P'RelQ' have "([(x, c)] ∙ P', [(x, c)] ∙ [(x, c)] ∙ Q') ∈ Rel"
by(rule eqvtRelI)
thus ?thesis by simp
qed
ultimately show "∃P'. P ⟹⇩l a<νx> ≺ P' ∧ (P', Q') ∈ Rel" by blast
next
assume QTrans: "Q ⟹⇩lα ≺ Q'"
then obtain Q'' Q''' where QChain: "Q ⟹⇩τ Q''"
and Q''Trans: "Q'' ⟼α ≺ Q'''"
and Q'''Chain: "Q''' ⟹⇩τ Q'"
by(blast dest: transitionE)
thus "∃P'. P ⟹⇩l α ≺ P' ∧ (P', Q') ∈ Rel"
proof(induct arbitrary: α Q''' Q' rule: tauChainInduct)
case(id α Q''')
from PSimQ ‹Q ⟼α ≺ Q'''› have "∃P'. P ⟹⇩lα ≺ P' ∧ (P', Q''') ∈ Rel"
by(blast dest: simE)
then obtain P''' where PTrans: "P ⟹⇩lα ≺ P'''" and P'RelQ''': "(P''', Q''') ∈ Rel"
by blast
have "∃P'. P''' ⟹⇩τ P' ∧ (P', Q') ∈ Rel" using ‹Q''' ⟹⇩τ Q'› P'RelQ''' Sim
by(rule Weak_Late_Sim.weakSimTauChain)
then obtain P' where P'''Chain: "P''' ⟹⇩τ P'" and P'RelQ': "(P', Q') ∈ Rel" by blast
from P'''Chain PTrans have "P ⟹⇩lα ≺ P'"
by(blast dest: Weak_Late_Step_Semantics.chainTransitionAppend)
with P'RelQ' show ?case by blast
next
case(ih Q'''' Q''' α Q'' Q')
have "Q''' ⟹⇩τ Q'''" by simp
with ‹Q'''' ⟼τ ≺ Q'''› obtain P''' where PTrans: "P ⟹⇩lτ ≺ P'''" and P'''RelQ''': "(P''', Q''') ∈ Rel"
by(drule_tac ih) auto
from P'''RelQ''' ‹Q''' ⟼α ≺ Q''› obtain P'' where
P'''Trans: "P''' ⟹⇩l⇧^α ≺ P''" and P''RelQ'': "(P'', Q'') ∈ Rel"
by(blast dest: Weak_Late_Sim.simE Sim)
from P''RelQ'' ‹Q'' ⟹⇩τ Q'› Sim obtain P' where
P''Chain: "P'' ⟹⇩τ P'" and P'RelQ': "(P', Q')∈ Rel"
by(drule_tac Weak_Late_Sim.weakSimTauChain) auto
from PTrans P'''Trans P''Chain have "P ⟹⇩lα ≺ P'"
apply(auto simp add: weakTransition_def residual.inject)
apply(drule_tac Weak_Late_Step_Semantics.tauTransitionChain, auto)
apply(drule_tac Weak_Late_Step_Semantics.chainTransitionAppend, simp)
apply(rule Weak_Late_Step_Semantics.chainTransitionAppend, auto)
by(drule_tac Weak_Late_Step_Semantics.chainTransitionAppend, auto)
with ‹(P', Q') ∈ Rel› show ?case by blast
qed
qed
lemma reflexive:
fixes P :: pi
and Rel :: "(pi × pi) set"
assumes "Id ⊆ Rel"
shows "P ↝<Rel> P"
using assms
by(auto intro: Weak_Late_Step_Semantics.singleActionChain simp add: weakStepSimDef)
lemma transitive:
fixes P :: pi
and Q :: pi
and R :: pi
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
and Rel'' :: "(pi × pi) set"
assumes PSimQ: "P ↝<Rel> Q"
and QSimR: "Q ↝<Rel'> R"
and Eqvt: "eqvt Rel"
and Eqvt': "eqvt Rel''"
and Trans: "Rel O Rel' ⊆ Rel''"
and Sim: "⋀P Q. (P, Q) ∈ Rel ⟹ P ↝⇧^<Rel> Q"
and PRelQ: "(P, Q) ∈ Rel"
shows "P ↝<Rel''> R"
using Eqvt'
proof(induct rule: simCasesCont[of _ "(P, Q)"])
case(Bound R' a x)
have RTrans: "R ⟼ a<νx> ≺ R'" by fact
have "x ♯ (P, Q)" by fact
hence xFreshP: "x ♯ P" and xFreshQ: "x ♯ Q" by(simp add: fresh_prod)+
from QSimR RTrans xFreshQ obtain Q' where QTrans: "Q ⟹⇩la<νx> ≺ Q'"
and Q'RelR': "(Q', R') ∈ Rel'"
by(blast dest: simE)
from PSimQ Sim Eqvt PRelQ QTrans xFreshP obtain P' where PTrans: "P ⟹⇩la<νx> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE2)
moreover from P'RelQ' Q'RelR' Trans have "(P', R') ∈ Rel''" by blast
ultimately show ?case by blast
next
case(Input R' a x)
have RTrans: "R ⟼ a<x> ≺ R'" by fact
have "x ♯ (P, Q)" by fact
hence xFreshP: "x ♯ P" and xFreshQ: "x ♯ Q" by(simp add: fresh_prod)+
from QSimR RTrans xFreshQ obtain Q''
where "∀u. ∃Q'. Q ⟹⇩lu in Q''→a<x> ≺ Q' ∧ (Q', R'[x::=u]) ∈ Rel'"
by(blast dest: simE)
hence "∃Q'''. Q ⟹⇩τ Q''' ∧ Q'''⟼a<x> ≺ Q'' ∧ (∀u. ∃Q'. Q''[x::=u]⟹⇩τ Q' ∧ (Q', R'[x::=u]) ∈ Rel')"
by(simp add: inputTransition_def, blast)
then obtain Q''' where QChain: "Q ⟹⇩τ Q'''"
and Q'''Trans: "Q''' ⟼a<x> ≺ Q''"
and L1: "∀u. ∃Q'. Q''[x::=u]⟹⇩τ Q' ∧ (Q', R'[x::=u]) ∈ Rel'"
by blast
from QChain PRelQ Sim obtain P''' where PChain: "P ⟹⇩τ P'''" and P'''RelQ''': "(P''', Q''') ∈ Rel"
by(drule_tac Weak_Late_Sim.weakSimTauChain) auto
from PChain xFreshP have xFreshP''': "x ♯ P'''" by(rule freshChain)
from P'''RelQ''' have "P''' ↝⇧^<Rel> Q'''" by(rule Sim)
with xFreshP''' Q'''Trans obtain P'''' where L2: "∀u. ∃P''. P''' ⟹⇩lu in P''''→a<x> ≺ P'' ∧ (P'', Q''[x::=u]) ∈ Rel"
by(blast dest: Weak_Late_Sim.simE)
have "∀u. ∃P' Q'. P ⟹⇩lu in P''''→a<x> ≺ P' ∧ (P', R'[x::=u]) ∈ Rel''"
proof(rule allI)
fix u
from L1 obtain Q' where Q''Chain: "Q''[x::=u] ⟹⇩τ Q'" and Q'RelR': "(Q', R'[x::=u]) ∈ Rel'"
by blast
from L2 obtain P'' where P'''Trans: "P''' ⟹⇩lu in P''''→a<x> ≺ P''"
and P''RelQ'': "(P'', Q''[x::=u]) ∈ Rel"
by blast
from P''RelQ'' have "P'' ↝⇧^<Rel> Q''[x::=u]" by(rule Sim)
have "∃P'. P'' ⟹⇩τ P' ∧ (P', Q') ∈ Rel" using Q''Chain P''RelQ'' Sim
by(rule Weak_Late_Sim.weakSimTauChain)
then obtain P' where P''Chain: "P'' ⟹⇩τ P'" and P'RelQ': "(P', Q') ∈ Rel" by blast
from PChain P'''Trans P''Chain have "P ⟹⇩lu in P''''→a<x> ≺ P'"
by(blast dest: Weak_Late_Step_Semantics.chainTransitionAppend)
moreover from P'RelQ' Q'RelR' have "(P', R'[x::=u]) ∈ Rel''" by(insert Trans, auto)
ultimately show "∃P' Q'. P ⟹⇩lu in P''''→a<x> ≺ P' ∧ (P', R'[x::=u]) ∈ Rel''" by blast
qed
thus ?case by force
next
case(Free R' α)
have RTrans: "R ⟼ α ≺ R'" by fact
with QSimR obtain Q' where QTrans: "Q ⟹⇩lα ≺ Q'" and Q'RelR': "(Q', R') ∈ Rel'"
by(blast dest: simE)
from PSimQ Sim Eqvt PRelQ QTrans obtain P' where PTrans: "P ⟹⇩lα ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE2)
from P'RelQ' Q'RelR' Trans have "(P', R') ∈ Rel''" by blast
with PTrans show ?case by blast
qed
end
Theory Weak_Late_Cong
theory Weak_Late_Cong
imports Weak_Late_Bisim Weak_Late_Step_Sim Strong_Late_Bisim
begin
definition congruence :: "(pi × pi) set" where
"congruence ≡ {(P, Q) |P Q. P ↝<weakBisim> Q ∧ Q ↝<weakBisim> P}"
abbreviation congruenceJudge (infixr "≃" 65) where "P ≃ Q ≡ (P, Q) ∈ congruence"
lemma unfoldE:
fixes P :: pi
and Q :: pi
and s :: "(name × name) list"
assumes "P ≃ Q"
shows "P ↝<weakBisim> Q"
and "Q ↝<weakBisim> P"
proof -
from assms show "P ↝<weakBisim> Q" by(force simp add: congruence_def)
next
from assms show "Q ↝<weakBisim> P" by(force simp add: congruence_def)
qed
lemma unfoldI:
fixes P :: pi
and Q :: pi
assumes "P ↝<weakBisim> Q"
and "Q ↝<weakBisim> P"
shows "P ≃ Q"
using assms by(force simp add: congruence_def)
lemma eqvt:
shows "eqvt congruence"
proof -
have "⋀P Q (perm::name prm). P ↝<weakBisim> Q ⟹ (perm ∙ P) ↝<weakBisim> (perm ∙ Q)"
proof -
fix P Q perm
assume "P ↝<weakBisim> Q"
thus "((perm::name prm) ∙ P) ↝<weakBisim> (perm ∙ Q)"
apply -
by(blast intro: Weak_Late_Step_Sim.eqvtI Weak_Late_Bisim.eqvt)
qed
thus ?thesis
by(simp add: congruence_def eqvt_def)
qed
lemma eqvtI:
fixes P :: pi
and Q :: pi
and perm :: "name prm"
assumes "P ≃ Q"
shows "(perm ∙ P) ≃ (perm ∙ Q)"
using assms
by(rule eqvtRelI[OF eqvt])
lemma strongBisimWeakEq:
fixes P :: pi
and Q :: pi
assumes "P ∼ Q"
shows "P ≃ Q"
proof -
have "⋀P Q. P ↝[bisim] Q ⟹ P ↝<weakBisim> Q"
proof -
fix P Q
assume "P ↝[bisim] Q"
hence "P ↝<bisim> Q" by(rule strongSimWeakEqSim)
moreover have "bisim ⊆ weakBisim"
by(auto intro: strongBisimWeakBisim)
ultimately show "P ↝<weakBisim> Q" by(rule Weak_Late_Step_Sim.monotonic)
qed
with assms show ?thesis
by(blast intro: unfoldI dest: Strong_Late_Bisim.bisimE Strong_Late_Bisim.symmetric)
qed
lemma congruenceWeakBisim:
fixes P :: pi
and Q :: pi
assumes "P ≃ Q"
shows "P ≈ Q"
proof -
let ?X = "{(P, Q) | P Q. P ≃ Q}"
from assms have "(P, Q) ∈ ?X" by auto
thus ?thesis
proof(coinduct rule: weakBisimCoinduct)
case(cSim P Q)
{
fix P Q
assume "P ≃ Q"
hence "P ↝<weakBisim> Q" by(simp add: congruence_def)
hence "P ↝<(?X ∪ weakBisim)> Q" by(rule_tac Weak_Late_Step_Sim.monotonic) auto
hence "P ↝⇧^<(?X ∪ weakBisim)> Q" by(rule Weak_Late_Step_Sim.weakSimWeakEqSim)
}
with ‹(P, Q) ∈ ?X› show ?case by auto
next
case(cSym P Q)
thus ?case by(auto simp add: congruence_def)
qed
qed
lemma congruenceSubsetWeakBisim:
shows "congruence ⊆ weakBisim"
by(auto intro: congruenceWeakBisim)
lemma reflexive:
fixes P :: pi
shows "P ≃ P"
proof -
from Weak_Late_Bisim.reflexive have "⋀P. P ↝<weakBisim> P"
by(blast intro: Weak_Late_Step_Sim.reflexive)
thus ?thesis
by(force simp add: substClosed_def congruence_def)
qed
lemma symetric:
fixes P :: pi
and Q :: pi
assumes "P ≃ Q"
shows "Q ≃ P"
using assms
by(force simp add: substClosed_def congruence_def)
lemma transitive:
fixes P :: pi
and Q :: pi
and R :: pi
assumes "P ≃ Q"
and "Q ≃ R"
shows "P ≃ R"
proof -
have Goal: "⋀P Q R. ⟦P ↝<weakBisim> Q; Q ↝<weakBisim> R; P ≈ Q⟧ ⟹ P ↝<weakBisim> R"
using Weak_Late_Bisim.eqvt Weak_Late_Bisim.unfoldE Weak_Late_Bisim.transitive
by(blast intro: Weak_Late_Step_Sim.transitive)
from assms show ?thesis
apply(simp add: congruence_def) using assms
by(blast intro: Goal dest: congruenceWeakBisim symetric)
qed
end
Theory Weak_Late_Bisim_Subst
theory Weak_Late_Bisim_Subst
imports Weak_Late_Bisim Strong_Late_Bisim_Subst
begin
consts weakBisimSubst :: "(pi × pi) set"
abbreviation
weakBisimSubstJudge (infixr "≈⇧s" 65) where "P ≈⇧s Q ≡ (P, Q) ∈ (substClosed weakBisim)"
lemma congBisim:
fixes P :: pi
and Q :: pi
assumes "P ≈⇧s Q"
shows "P ≈ Q"
proof -
from assms substClosedSubset show ?thesis
by blast
qed
lemma strongBisimWeakBisim:
fixes P :: pi
and Q :: pi
assumes "P ∼⇧s Q"
shows "P ≈⇧s Q"
using assms
by(auto simp add: substClosed_def intro: strongBisimWeakBisim)
lemma eqvt:
shows "eqvt (substClosed weakBisim)"
by(rule eqvtSubstClosed[OF Weak_Late_Bisim.eqvt])
lemma eqvtI:
fixes P :: pi
and Q :: pi
and perm :: "name prm"
assumes "P ≈⇧s Q"
shows "(perm ∙ P) ≈⇧s (perm ∙ Q)"
using assms
by(rule_tac eqvtRelI[OF eqvt])
lemma reflexive:
fixes P :: pi
shows "P ≈⇧s P"
by(force simp add: substClosed_def intro: Weak_Late_Bisim.reflexive)
lemma symetric:
fixes P :: pi
and Q :: pi
assumes "P ≈⇧s Q"
shows "Q ≈⇧s P"
using assms
by(force simp add: substClosed_def intro: Weak_Late_Bisim.symmetric)
lemma transitive:
fixes P :: pi
and Q :: pi
and R :: pi
assumes "P ≈⇧s Q"
and "Q ≈⇧s R"
shows "P ≈⇧s R"
using assms
by(force simp add: substClosed_def intro: Weak_Late_Bisim.transitive)
lemma partUnfold:
fixes P :: pi
and Q :: pi
and s :: "(name × name) list"
assumes "P ≈⇧s Q"
shows "P[<s>] ≈⇧s Q[<s>]"
using assms
proof(auto simp add: substClosed_def)
fix s'
assume "∀s. P[<s>] ≈ Q[<s>]"
hence "P[<(s@s')>] ≈ Q[<(s@s')>]" by blast
moreover have "P[<(s@s')>] = (P[<s>])[<s'>]"
by(induct s', auto)
moreover have "Q[<(s@s')>] = (Q[<s>])[<s'>]"
by(induct s', auto)
ultimately show "(P[<s>])[<s'>] ≈ (Q[<s>])[<s'>]"
by simp
qed
end
Theory Weak_Late_Cong_Subst
theory Weak_Late_Cong_Subst
imports Weak_Late_Cong Weak_Late_Bisim_Subst Strong_Late_Bisim_Subst
begin
definition congruenceSubst :: "pi ⇒ pi⇒ bool" (infixr "≃⇧s" 65) where
"P ≃⇧s Q ≡ (P, Q) ∈ (substClosed congruence)"
lemmas congruenceSubstDef = congruenceSubst_def congruence_def substClosed_def
lemma unfoldE:
fixes P :: pi
and Q :: pi
and s :: "(name × name) list"
assumes "P ≃⇧s Q"
shows "P[<s>] ↝<weakBisim> Q[<s>]"
and "Q[<s>] ↝<weakBisim> P[<s>]"
proof -
from assms show "P[<s>] ↝<weakBisim> Q[<s>]" by(force simp add: congruenceSubstDef)
next
from assms show "Q[<s>] ↝<weakBisim> P[<s>]" by(force simp add: congruenceSubstDef)
qed
lemma unfoldI:
fixes P :: pi
and Q :: pi
assumes "∀s. P[<s>] ↝<weakBisim> Q[<s>] ∧ Q[<s>] ↝<weakBisim> P[<s>]"
shows "P ≃⇧s Q"
proof -
from assms show ?thesis by(force simp add: congruenceSubstDef)
qed
lemma weakEqSubset:
shows "substClosed congruence ⊆ weakBisim"
proof(auto simp add: substClosed_def)
fix P Q
assume "∀s. P[<s>] ≃ Q[<s>]"
hence "P[<[]>] ≃ Q[<[]>]" by blast
thus "P ≈ Q"
by(force dest: congruenceWeakBisim intro: Weak_Late_Bisim.unfoldI)
qed
lemma weakCongWeakEq:
fixes P :: pi
and Q :: pi
assumes "P ≃⇧s Q"
shows "P ≃ Q"
using assms
apply(auto simp add: substClosed_def congruenceSubst_def)
apply(erule_tac x="[]" in allE)
by auto
lemma eqvt:
shows "eqvt (substClosed congruence)"
by(rule eqvtSubstClosed[OF Weak_Late_Cong.eqvt])
lemma eqvtI:
fixes P :: pi
and Q :: pi
and perm :: "name prm"
assumes "P ≃⇧s Q"
shows "(perm ∙ P) ≃⇧s (perm ∙ Q)"
using assms
by(simp add: congruenceSubst_def) (rule eqvtRelI[OF eqvt])
lemma strongEqWeakCong:
fixes P :: pi
and Q :: pi
assumes "P ∼⇧s Q"
shows "P ≃⇧s Q"
using assms
by(force intro: strongBisimWeakEq simp add: substClosed_def congruenceSubst_def)
lemma congSubstBisimSubst:
fixes P :: pi
and Q :: pi
assumes "P ≃⇧s Q"
shows "P ≈⇧s Q"
using assms
by(force simp add: congruenceSubst_def substClosed_def intro: congruenceWeakBisim)
lemma reflexive:
fixes P :: pi
shows "P ≃⇧s P"
proof -
from Weak_Late_Bisim.reflexive have "⋀P. P ↝<weakBisim> P"
by(blast intro: Weak_Late_Step_Sim.reflexive)
thus ?thesis
by(force simp add: congruenceSubstDef)
qed
lemma symetric:
fixes P :: pi
and Q :: pi
assumes "P ≃⇧s Q"
shows "Q ≃⇧s P"
using assms
by(force simp add: congruenceSubstDef)
lemma transitive:
fixes P :: pi
and Q :: pi
and R :: pi
assumes "P ≃⇧s Q"
and "Q ≃⇧s R"
shows "P ≃⇧s R"
using assms
by(force simp add: congruenceSubst_def substClosed_def intro: Weak_Late_Cong.transitive)
lemma partUnfold:
fixes P :: pi
and Q :: pi
and s :: "(name × name) list"
assumes "P ≃⇧s Q"
shows "P[<s>] ≃⇧s Q[<s>]"
using assms
proof(auto simp add: congruenceSubst_def substClosed_def)
fix s'
assume "∀s. (P[<s>], Q[<s>]) ∈ congruence"
hence "(P[<(s@s')>], Q[<(s@s')>]) ∈ congruence" by blast
moreover have "P[<(s@s')>] = (P[<s>])[<s'>]"
by(induct s', auto)
moreover have "Q[<(s@s')>] = (Q[<s>])[<s'>]"
by(induct s', auto)
ultimately show "((P[<s>])[<s'>], (Q[<s>])[<s'>]) ∈ congruence"
by simp
qed
end
Theory Strong_Late_Sim_SC
theory Strong_Late_Sim_SC
imports Strong_Late_Sim
begin
lemma nilSim[dest]:
fixes a :: name
and b :: name
and x :: name
and P :: pi
and Q :: pi
shows "𝟬 ↝[Rel] τ.(P) ⟹ False"
and "𝟬 ↝[Rel] a<x>.P ⟹ False"
and "𝟬 ↝[Rel] a{b}.P ⟹ False"
by(fastforce simp add: simulation_def intro: Tau Input Output)+
lemma nilSimRight:
fixes P :: pi
and Rel :: "(pi × pi) set"
shows "P ↝[Rel] 𝟬"
by(auto simp add: simulation_def)
lemma matchIdLeft:
fixes a :: name
and P :: pi
and Rel :: "(pi × pi) set"
assumes "Id ⊆ Rel"
shows "[a⌢a]P ↝[Rel] P"
using assms
by(force simp add: simulation_def dest: Match derivativeReflexive)
lemma matchIdRight:
fixes P :: pi
and a :: name
and Rel :: "(pi × pi) set"
assumes IdRel: "Id ⊆ Rel"
shows "P ↝[Rel] [a⌢a]P"
using assms
by(fastforce simp add: simulation_def elim: matchCases intro: derivativeReflexive)
lemma matchNilLeft:
fixes a :: name
and b :: name
and P :: pi
assumes "a ≠ b"
shows "𝟬 ↝[Rel] [a⌢b]P"
using assms
by(auto simp add: simulation_def)
lemma mismatchIdLeft:
fixes a :: name
and b :: name
and P :: pi
and Rel :: "(pi × pi) set"
assumes "Id ⊆ Rel"
and "a ≠ b"
shows "[a≠b]P ↝[Rel] P"
using assms
by(fastforce simp add: simulation_def intro: Mismatch dest: derivativeReflexive)
lemma mismatchIdRight:
fixes P :: pi
and a :: name
and b :: name
and Rel :: "(pi × pi) set"
assumes IdRel: "Id ⊆ Rel"
and aineqb: "a ≠ b"
shows "P ↝[Rel] [a≠b]P"
using assms
by(fastforce simp add: simulation_def elim: mismatchCases intro: derivativeReflexive)
lemma mismatchNilLeft:
fixes a :: name
and P :: pi
shows "𝟬 ↝[Rel] [a≠a]P"
by(auto simp add: simulation_def)
lemma sumSym:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
assumes Id: "Id ⊆ Rel"
shows "P ⊕ Q ↝[Rel] Q ⊕ P"
using assms
by(fastforce simp add: simulation_def elim: sumCases intro: Sum1 Sum2 derivativeReflexive)
lemma sumIdempLeft:
fixes P :: pi
and Rel :: "(pi × pi) set"
assumes "Id ⊆ Rel"
shows "P ↝[Rel] P ⊕ P"
using assms
by(fastforce simp add: simulation_def elim: sumCases intro: derivativeReflexive)
lemma sumIdempRight:
fixes P :: pi
and Rel :: "(pi × pi) set"
assumes I: "Id ⊆ Rel"
shows "P ⊕ P ↝[Rel] P"
using assms
by(fastforce simp add: simulation_def intro: Sum1 derivativeReflexive)
lemma sumAssocLeft:
fixes P :: pi
and Q :: pi
and R :: pi
and Rel :: "(pi × pi) set"
assumes Id: "Id ⊆ Rel"
shows "(P ⊕ Q) ⊕ R ↝[Rel] P ⊕ (Q ⊕ R)"
using assms
by(fastforce simp add: simulation_def elim: sumCases intro: Sum1 Sum2 derivativeReflexive)
lemma sumAssocRight:
fixes P :: pi
and Q :: pi
and R :: pi
and Rel :: "(pi × pi) set"
assumes Id: "Id ⊆ Rel"
shows "P ⊕ (Q ⊕ R) ↝[Rel] (P ⊕ Q) ⊕ R"
using assms
by(fastforce simp add: simulation_def elim: sumCases intro: Sum1 Sum2 derivativeReflexive)
lemma sumZeroLeft:
fixes P :: pi
and Rel :: "(pi × pi) set"
assumes Id: "Id ⊆ Rel"
shows "P ⊕ 𝟬 ↝[Rel] P"
using assms
by(fastforce simp add: simulation_def intro: Sum1 derivativeReflexive)
lemma sumZeroRight:
fixes P :: pi
and Rel :: "(pi × pi) set"
assumes Id: "Id ⊆ Rel"
shows "P ↝[Rel] P ⊕ 𝟬"
using assms
by(fastforce simp add: simulation_def elim: sumCases intro: derivativeReflexive)
lemma sumResLeft:
fixes x :: name
and P :: pi
and Q :: pi
assumes Id: "Id ⊆ Rel"
and Eqvt: "eqvt Rel"
shows "(<νx>P) ⊕ (<νx>Q) ↝[Rel] <νx>(P ⊕ Q)"
using Eqvt
proof(induct rule: simCasesCont[where C="(x, P, Q)"])
case(Bound a y PQ)
from ‹y ♯ (x, P, Q)› have "y ≠ x" and "y ♯ P" and "y ♯ Q" by(simp add: fresh_prod)+
hence "y ♯ P ⊕ Q" by simp
with ‹<νx>(P ⊕ Q) ⟼a«y» ≺ PQ› ‹y ≠ x› show ?case
proof(induct rule: resCasesB)
case(cOpen a PQ)
from ‹P ⊕ Q ⟼a[x] ≺ PQ› ‹y ♯ P› ‹y ♯ Q› have "y ♯ PQ" by(force dest: freshFreeDerivative)
from ‹P ⊕ Q ⟼a[x] ≺ PQ› show ?case
proof(induct rule: sumCases)
case cSum1
from ‹P ⟼a[x] ≺ PQ› ‹a ≠ x› have "<νx>P ⟼a<νx> ≺ PQ" by(rule Open)
hence "(<νx>P) ⊕ (<νx>Q) ⟼a<νx> ≺ PQ" by(rule Sum1)
with ‹y ♯ PQ› have "(<νx>P) ⊕ (<νx>Q) ⟼a<νy> ≺ ([(y, x)] ∙ PQ)"
by(simp add: alphaBoundResidual)
moreover from Id have "derivative ([(y, x)] ∙ PQ) ([(y, x)] ∙ PQ) (BoundOutputS a) y Rel"
by(force simp add: derivative_def)
ultimately show ?case by blast
next
case cSum2
from ‹Q ⟼a[x] ≺ PQ› ‹a ≠ x› have "<νx>Q ⟼a<νx> ≺ PQ" by(rule Open)
hence "(<νx>P) ⊕ (<νx>Q) ⟼a<νx> ≺ PQ" by(rule Sum2)
with ‹y ♯ PQ› have "(<νx>P) ⊕ (<νx>Q) ⟼a<νy> ≺ ([(y, x)] ∙ PQ)"
by(simp add: alphaBoundResidual)
moreover from Id have "derivative ([(y, x)] ∙ PQ) ([(y, x)] ∙ PQ) (BoundOutputS a) y Rel"
by(force simp add: derivative_def)
ultimately show ?case by blast
qed
next
case(cRes PQ)
from ‹P ⊕ Q ⟼a«y» ≺ PQ› show ?case
proof(induct rule: sumCases)
case cSum1
from ‹P ⟼a«y» ≺ PQ› ‹x ♯ a› ‹y ≠ x› have "<νx>P ⟼a«y» ≺ <νx>PQ" by(rule_tac ResB) auto
hence "(<νx>P) ⊕ (<νx>Q) ⟼a«y» ≺ <νx>PQ" by(rule Sum1)
moreover from Id have "derivative (<νx>PQ) (<νx>PQ) a y Rel"
by(cases a) (auto simp add: derivative_def)
ultimately show ?case by blast
next
case cSum2
from ‹Q ⟼a«y» ≺ PQ› ‹x ♯ a› ‹y ≠ x› have "<νx>Q ⟼a«y» ≺ <νx>PQ" by(rule_tac ResB) auto
hence "(<νx>P) ⊕ (<νx>Q) ⟼a«y» ≺ <νx>PQ" by(rule Sum2)
moreover from Id have "derivative (<νx>PQ) (<νx>PQ) a y Rel"
by(cases a) (auto simp add: derivative_def)
ultimately show ?case by blast
qed
qed
next
case(Free α PQ)
from ‹<νx>(P ⊕ Q) ⟼α ≺ PQ› show ?case
proof(induct rule: resCasesF)
case(cRes PQ)
from ‹P ⊕ Q ⟼α ≺ PQ› show ?case
proof(induct rule: sumCases)
case cSum1
from ‹P ⟼α ≺ PQ› ‹x ♯ α› have "<νx>P ⟼α ≺ <νx>PQ" by(rule ResF)
hence "(<νx>P) ⊕ (<νx>Q) ⟼α ≺ <νx>PQ" by(rule Sum1)
with Id show ?case by blast
next
case cSum2
from ‹Q ⟼α ≺ PQ› ‹x ♯ α› have "<νx>Q ⟼α ≺ <νx>PQ" by(rule ResF)
hence "(<νx>P) ⊕ (<νx>Q) ⟼α ≺ <νx>PQ" by(rule Sum2)
with Id show ?case by blast
qed
qed
qed
lemma sumResRight:
fixes x :: name
and P :: pi
and Q :: pi
assumes Id: "Id ⊆ Rel"
and Eqvt: "eqvt Rel"
shows "<νx>(P ⊕ Q) ↝[Rel] (<νx>P) ⊕ (<νx>Q)"
using ‹eqvt Rel›
proof(induct rule: simCasesCont[where C="(x, P, Q)"])
case(Bound a y PQ)
from ‹y ♯ (x, P, Q)› have "y ≠ x" and "y ♯ P" and "y ♯ Q" by(simp add: fresh_prod)+
from ‹(<νx>P) ⊕ (<νx>Q) ⟼a«y» ≺ PQ› show ?case
proof(induct rule: sumCases)
case cSum1
from ‹<νx>P ⟼a«y» ≺ PQ› show ?case using ‹y ≠ x› ‹y ♯ P›
proof(induct rule: resCasesB)
case(cOpen a P')
from ‹P ⟼a[x] ≺ P'› ‹y ♯ P› have "y ♯ P'" by(rule freshFreeDerivative)
from ‹P ⟼a[x] ≺ P'› have "P ⊕ Q ⟼a[x] ≺ P'" by(rule Sum1)
hence "<νx>(P ⊕ Q) ⟼a<νx> ≺ P'" using ‹a ≠ x› by(rule Open)
with ‹y ♯ P'› have "<νx>(P ⊕ Q) ⟼a<νy> ≺ [(y, x)] ∙ P'" by(simp add: alphaBoundResidual)
moreover from Id have "derivative ([(y, x)] ∙ P') ([(y, x)] ∙ P') (BoundOutputS a) y Rel"
by(force simp add: derivative_def)
ultimately show ?case by blast
next
case(cRes P')
from ‹P ⟼a«y» ≺ P'› have "P ⊕ Q ⟼a«y» ≺ P'" by(rule Sum1)
hence "<νx>(P ⊕ Q) ⟼a«y» ≺ <νx>P'" using ‹x ♯ a› ‹y ≠ x› by(rule_tac ResB) auto
moreover from Id have "derivative (<νx>P') (<νx>P') a y Rel"
by(cases a) (auto simp add: derivative_def)
ultimately show ?case by blast
qed
next
case cSum2
from ‹<νx>Q ⟼a«y» ≺ PQ› show ?case using ‹y ≠ x› ‹y ♯ Q›
proof(induct rule: resCasesB)
case(cOpen a Q')
from ‹Q ⟼a[x] ≺ Q'› ‹y ♯ Q› have "y ♯ Q'" by(rule freshFreeDerivative)
from ‹Q ⟼a[x] ≺ Q'› have "P ⊕ Q ⟼a[x] ≺ Q'" by(rule Sum2)
hence "<νx>(P ⊕ Q) ⟼a<νx> ≺ Q'" using ‹a ≠ x› by(rule Open)
with ‹y ♯ Q'› have "<νx>(P ⊕ Q) ⟼a<νy> ≺ [(y, x)] ∙ Q'" by(simp add: alphaBoundResidual)
moreover from Id have "derivative ([(y, x)] ∙ Q') ([(y, x)] ∙ Q') (BoundOutputS a) y Rel"
by(force simp add: derivative_def)
ultimately show ?case by blast
next
case(cRes Q')
from ‹Q ⟼a«y» ≺ Q'› have "P ⊕ Q ⟼a«y» ≺ Q'" by(rule Sum2)
hence "<νx>(P ⊕ Q) ⟼a«y» ≺ <νx>Q'" using ‹x ♯ a› ‹y ≠ x› by(rule_tac ResB) auto
moreover from Id have "derivative (<νx>Q') (<νx>Q') a y Rel"
by(cases a) (auto simp add: derivative_def)
ultimately show ?case by blast
qed
qed
next
case(Free α PQ)
from ‹(<νx>P) ⊕ (<νx>Q) ⟼α ≺ PQ› show ?case
proof(induct rule: sumCases)
case cSum1
from ‹<νx>P ⟼α ≺ PQ› show ?case
proof(induct rule: resCasesF)
case(cRes P')
from ‹P ⟼α ≺ P'› have "P ⊕ Q ⟼α ≺ P'" by(rule Sum1)
hence "<νx>(P ⊕ Q) ⟼α ≺ <νx>P'" using ‹x ♯ α› by(rule ResF)
with Id show ?case by blast
qed
next
case cSum2
from ‹<νx>Q ⟼α ≺ PQ› show ?case
proof(induct rule: resCasesF)
case(cRes Q')
from ‹Q ⟼α ≺ Q'› have "P ⊕ Q ⟼α ≺ Q'" by(rule Sum2)
hence "<νx>(P ⊕ Q) ⟼α ≺ <νx>Q'" using ‹x ♯ α› by(rule ResF)
with Id show ?case by blast
qed
qed
qed
lemma parZeroLeft:
fixes P :: pi
and Rel :: "(pi × pi) set"
assumes ParZero: "⋀Q. (Q ∥ 𝟬, Q) ∈ Rel"
shows "P ∥ 𝟬 ↝[Rel] P"
proof -
{
fix P Q a x
from ParZero have "derivative (P ∥ 𝟬) P a x Rel"
by(case_tac a) (auto simp add: derivative_def)
}
thus ?thesis using assms
by(fastforce simp add: simulation_def intro: Par1B Par1F)
qed
lemma parZeroRight:
fixes P :: pi
and Rel :: "(pi × pi) set"
assumes ParZero: "⋀Q. (Q, Q ∥ 𝟬) ∈ Rel"
shows "P ↝[Rel] P ∥ 𝟬"
proof -
{
fix P Q a x
from ParZero have "derivative P (P ∥ 𝟬) a x Rel"
by(case_tac a) (auto simp add: derivative_def)
}
thus ?thesis using assms
by(fastforce simp add: simulation_def elim: parCasesF parCasesB)+
qed
lemma parSym:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
assumes Sym: "⋀R S. (R ∥ S, S ∥ R) ∈ Rel"
and Res: "⋀R S x. (R, S) ∈ Rel ⟹ (<νx>R, <νx>S) ∈ Rel"
shows "P ∥ Q ↝[Rel] Q ∥ P"
proof(induct rule: simCases)
case(Bound a x QP)
from ‹x ♯ (P ∥ Q)› have "x ♯ Q" and "x ♯ P" by simp+
with ‹Q ∥ P ⟼ a«x» ≺ QP› show ?case
proof(induct rule: parCasesB)
case(cPar1 Q')
from ‹Q ⟼a«x» ≺ Q'› have "P ∥ Q ⟼a«x» ≺ P ∥ Q'" using ‹x ♯ P› by(rule Par2B)
moreover have "derivative (P ∥ Q') (Q' ∥ P) a x Rel"
by(cases a, auto simp add: derivative_def intro: Sym)
ultimately show ?case by blast
next
case(cPar2 P')
from ‹P ⟼a«x» ≺ P'› have "P ∥ Q ⟼a«x» ≺ P' ∥ Q" using ‹x ♯ Q› by(rule Par1B)
moreover have "derivative (P' ∥ Q) (Q ∥ P') a x Rel"
by(cases a, auto simp add: derivative_def intro: Sym)
ultimately show ?case by blast
qed
next
case(Free α QP)
from ‹Q ∥ P ⟼ α ≺ QP› show ?case
proof(induct rule: parCasesF[where C="()"])
case(cPar1 Q')
from ‹Q ⟼ α ≺ Q'› have "P ∥ Q ⟼ α ≺ P ∥ Q'" by(rule Par2F)
moreover have "(P ∥ Q', Q' ∥ P) ∈ Rel" by(rule Sym)
ultimately show ?case by blast
next
case(cPar2 P')
from ‹P ⟼ α ≺ P'› have "P ∥ Q ⟼ α ≺ P' ∥ Q" by(rule Par1F)
moreover have "(P' ∥ Q, Q ∥ P') ∈ Rel" by(rule Sym)
ultimately show ?case by blast
next
case(cComm1 Q' P' a b x)
from ‹P ⟼a[b] ≺ P'› ‹Q ⟼a<x> ≺ Q'›
have "P ∥ Q ⟼ τ ≺ P' ∥ (Q'[x::=b])" by(rule Comm2)
moreover have "(P' ∥ Q'[x::=b], Q'[x::=b] ∥ P') ∈ Rel" by(rule Sym)
ultimately show ?case by blast
next
case(cComm2 Q' P' a b x)
from ‹P ⟼a<x> ≺ P'› ‹Q ⟼a[b] ≺ Q'›
have "P ∥ Q ⟼ τ ≺ (P'[x::=b]) ∥ Q'" by(rule Comm1)
moreover have "(P'[x::=b] ∥ Q', Q' ∥ P'[x::=b]) ∈ Rel" by(rule Sym)
ultimately show ?case by blast
next
case(cClose1 Q' P' a x y)
from ‹P ⟼ a<νy> ≺ P'› ‹Q ⟼ a<x> ≺ Q'› ‹y ♯ Q›
have "P ∥ Q ⟼ τ ≺ <νy>(P' ∥ (Q'[x::=y]))" by(rule Close2)
moreover have "(<νy>(P' ∥ Q'[x::=y]), <νy>(Q'[x::=y] ∥ P')) ∈ Rel" by(metis Res Sym)
ultimately show ?case by blast
next
case(cClose2 Q' P' a x y)
from ‹P ⟼ a<x> ≺ P'› ‹Q ⟼ a<νy> ≺ Q'› ‹y ♯ P›
have "P ∥ Q ⟼ τ ≺ <νy>((P'[x::=y]) ∥ Q')" by(rule Close1)
moreover have "(<νy>(P'[x::=y] ∥ Q'), <νy>(Q' ∥ P'[x::=y])) ∈ Rel" by(metis Res Sym)
ultimately show ?case by blast
qed
qed
lemma parAssocLeft:
fixes P :: pi
and Q :: pi
and R :: pi
and Rel :: "(pi × pi) set"
assumes Ass: "⋀S T U. ((S ∥ T) ∥ U, S ∥ (T ∥ U)) ∈ Rel"
and Res: "⋀S T x. (S, T) ∈ Rel ⟹ (<νx>S, <νx>T) ∈ Rel"
and FreshExt: "⋀S T U x. x ♯ S ⟹ (<νx>((S ∥ T) ∥ U), S ∥ <νx>(T ∥ U)) ∈ Rel"
and FreshExt': "⋀S T U x. x ♯ U ⟹ ((<νx>(S ∥ T)) ∥ U, <νx>(S ∥ (T ∥ U))) ∈ Rel"
shows "(P ∥ Q) ∥ R ↝[Rel] P ∥ (Q ∥ R)"
proof(induct rule: simCases)
case(Bound a x PQR)
from ‹x ♯ (P ∥ Q) ∥ R› have "x ♯ P" and "x ♯ Q" and "x ♯ R" by simp+
hence "x ♯ (Q ∥ R)" by simp
with ‹P ∥ (Q ∥ R) ⟼ a«x» ≺ PQR› ‹x ♯ P› show ?case
proof(induct rule: parCasesB)
case(cPar1 P')
from ‹P ⟼ a«x» ≺ P'› have "P ∥ Q ⟼ a«x» ≺ P' ∥ Q" using ‹x ♯ Q› by(rule Par1B)
hence "(P ∥ Q) ∥ R ⟼ a«x» ≺ (P' ∥ Q) ∥ R" using ‹x ♯ R› by(rule Par1B)
moreover have "derivative ((P' ∥ Q) ∥ R) (P' ∥ (Q ∥ R)) a x Rel"
by(cases a, auto intro: Ass simp add: derivative_def)
ultimately show ?case by blast
next
case(cPar2 QR)
from ‹Q ∥ R ⟼ a«x» ≺ QR› ‹x ♯ Q› ‹x ♯ R› show ?case
proof(induct rule: parCasesB)
case(cPar1 Q')
from ‹Q ⟼ a«x» ≺ Q'› have "P ∥ Q ⟼ a«x» ≺ P ∥ Q'" using ‹x ♯ P› by(rule Par2B)
hence "(P ∥ Q) ∥ R ⟼ a«x» ≺ (P ∥ Q') ∥ R" using ‹x ♯ R›by(rule Par1B)
moreover have "derivative ((P ∥ Q') ∥ R) (P ∥ (Q' ∥ R)) a x Rel"
by(cases a, auto intro: Ass simp add: derivative_def)
ultimately show ?case by blast
next
case(cPar2 R')
from ‹R ⟼ a«x» ≺ R'› have "(P ∥ Q) ∥ R ⟼ a«x» ≺ (P ∥ Q) ∥ R'" using ‹x ♯ P› ‹x ♯ Q›
by(rule_tac Par2B) auto
moreover have "derivative ((P ∥ Q) ∥ R') (P ∥ (Q ∥ R')) a x Rel"
by(cases a, auto intro: Ass simp add: derivative_def)
ultimately show ?case by blast
qed
qed
next
case(Free α PQR)
from ‹P ∥ (Q ∥ R) ⟼ α ≺ PQR› show ?case
proof(induct rule: parCasesF[where C="Q"])
case(cPar1 P')
from ‹P ⟼ α ≺ P'› have "P ∥ Q ⟼ α ≺ P' ∥ Q" by(rule Par1F)
hence "(P ∥ Q) ∥ R ⟼ α ≺ (P' ∥ Q) ∥ R" by(rule Par1F)
moreover from Ass have "((P' ∥ Q) ∥ R, P' ∥ (Q ∥ R)) ∈ Rel" by blast
ultimately show ?case by blast
next
case(cPar2 QR)
from ‹Q ∥ R ⟼ α ≺ QR› show ?case
proof(induct rule: parCasesF[where C="P"])
case(cPar1 Q')
from ‹Q ⟼ α ≺ Q'› have "(P ∥ Q) ⟼ α ≺ P ∥ Q'" by(rule Par2F)
hence "(P ∥ Q) ∥ R ⟼ α ≺ (P ∥ Q') ∥ R" by(rule Par1F)
moreover from Ass have "((P ∥ Q') ∥ R, P ∥ (Q' ∥ R)) ∈ Rel" by blast
ultimately show ?case by blast
next
case(cPar2 R')
from ‹R ⟼ α ≺ R'› have "(P ∥ Q) ∥ R ⟼ α ≺ (P ∥ Q) ∥ R'" by(rule Par2F)
moreover from Ass have "((P ∥ Q) ∥ R', P ∥ (Q ∥ R')) ∈ Rel" by blast
ultimately show ?case by blast
next
case(cComm1 Q' R' a b x)
from ‹Q ⟼a<x> ≺ Q'› ‹x ♯ P› have "P ∥ Q ⟼a<x> ≺ P ∥ Q'" by(rule Par2B)
hence "(P ∥ Q) ∥ R ⟼ τ ≺ (P ∥ Q')[x::=b] ∥ R'" using ‹R ⟼a[b] ≺ R'› by(rule Comm1)
with ‹x ♯ P› have "(P ∥ Q) ∥ R ⟼ τ ≺ (P ∥ (Q'[x::=b])) ∥ R'" by(simp add: forget)
moreover from Ass have "((P ∥ (Q'[x::=b])) ∥ R', P ∥ (Q'[x::=b] ∥ R')) ∈ Rel" by blast
ultimately show ?case by blast
next
case(cComm2 Q' R' a b x)
from ‹Q ⟼a[b] ≺ Q'› have "P ∥ Q ⟼a[b] ≺ P ∥ Q'" by(rule Par2F)
with ‹x ♯ P› ‹x ♯ Q› ‹R ⟼a<x> ≺ R'› have "(P ∥ Q) ∥ R ⟼ τ ≺ (P ∥ Q') ∥ R'[x::=b]"
by(force intro: Comm2)
moreover from Ass have "((P ∥ Q') ∥ R'[x::=b], P ∥ (Q' ∥ R'[x::=b])) ∈ Rel" by blast
ultimately show ?case by blast
next
case(cClose1 Q' R' a x y)
from ‹Q ⟼a<x> ≺ Q'› ‹x ♯ P› have "P ∥ Q ⟼a<x> ≺ P ∥ Q'" by(rule Par2B)
with ‹y ♯ P› ‹y ♯ Q› ‹x ♯ P› ‹R ⟼a<νy> ≺ R'› have "(P ∥ Q) ∥ R ⟼ τ ≺ <νy>((P ∥ Q')[x::=y] ∥ R')"
by(rule_tac Close1) auto
with ‹x ♯ P› have "(P ∥ Q) ∥ R ⟼ τ ≺ <νy>((P ∥ (Q'[x::=y])) ∥ R')" by(simp add: forget)
moreover from ‹y ♯ P› have "(<νy>((P ∥ Q'[x::=y]) ∥ R'), P ∥ <νy>(Q'[x::=y] ∥ R')) ∈ Rel"
by(rule FreshExt)
ultimately show ?case by blast
next
case(cClose2 Q' R' a x y)
from ‹Q ⟼a<νy> ≺ Q'› ‹y ♯ P› have "P ∥ Q ⟼a<νy> ≺ P ∥ Q'" by(rule Par2B)
hence Act: "(P ∥ Q) ∥ R ⟼ τ ≺ <νy>((P ∥ Q') ∥ R'[x::=y])" using ‹R ⟼a<x> ≺ R'› ‹y ♯ R› by(rule Close2)
moreover from ‹y ♯ P› have "(<νy>((P ∥ Q') ∥ R'[x::=y]), P ∥ <νy>(Q' ∥ R'[x::=y])) ∈ Rel"
by(rule FreshExt)
ultimately show ?case by blast
qed
next
case(cComm1 P' QR a b x)
from ‹Q ∥ R ⟼ a[b] ≺ QR› show ?case
proof(induct rule: parCasesF[where C="()"])
case(cPar1 Q')
from ‹P ⟼a<x> ≺ P'› ‹Q ⟼a[b] ≺ Q'› have "P ∥ Q ⟼ τ ≺ P'[x::=b] ∥ Q'" by(rule Comm1)
hence "(P ∥ Q) ∥ R ⟼ τ ≺ (P'[x::=b] ∥ Q') ∥ R" by(rule Par1F)
moreover from Ass have "((P'[x::=b] ∥ Q') ∥ R, P'[x::=b] ∥ (Q' ∥ R)) ∈ Rel" by blast
ultimately show ?case by blast
next
case(cPar2 R')
from ‹P ⟼a<x> ≺ P'› ‹x ♯ Q› have "P ∥ Q ⟼ a<x> ≺ P' ∥ Q" by(rule Par1B)
hence "(P ∥ Q) ∥ R ⟼ τ ≺ (P' ∥ Q)[x::=b] ∥ R'" using ‹R ⟼ a[b] ≺ R'› by(rule Comm1)
with ‹x ♯ Q› have "(P ∥ Q) ∥ R ⟼ τ ≺ (P'[x::=b] ∥ Q) ∥ R'" by(simp add: forget)
moreover from Ass have "((P'[x::=b] ∥ Q) ∥ R', P'[x::=b] ∥ (Q ∥ R')) ∈ Rel" by blast
ultimately show ?case by blast
next
case(cComm1 Q' R')
from ‹a[b] = τ› have False by simp thus ?case by simp
next
case(cComm2 Q' R')
from ‹a[b] = τ› have False by simp thus ?case by simp
next
case(cClose1 Q' R')
from ‹a[b] = τ› have False by simp thus ?case by simp
next
case(cClose2 Q' R')
from ‹a[b] = τ› have False by simp thus ?case by simp
qed
next
case(cComm2 P' QR a b x)
from ‹x ♯ Q ∥ R› have "x ♯ Q" and "x ♯ R" by simp+
with ‹Q ∥ R ⟼ a<x> ≺ QR› show ?case
proof(induct rule: parCasesB)
case(cPar1 Q')
from ‹P ⟼a[b] ≺ P'› ‹Q ⟼ a<x> ≺ Q'› have "P ∥ Q ⟼ τ ≺ P' ∥ (Q'[x::=b])" by(rule Comm2)
hence "(P ∥ Q) ∥ R ⟼ τ ≺ (P' ∥ Q'[x::=b]) ∥ R" by(rule Par1F)
moreover from Ass have "((P' ∥ Q'[x::=b]) ∥ R, P' ∥ Q'[x::=b] ∥ R) ∈ Rel" by blast
with ‹x ♯ R› have "((P' ∥ Q'[x::=b]) ∥ R, P' ∥ (Q' ∥ R)[x::=b]) ∈ Rel" by(force simp add: forget)
ultimately show ?case by blast
next
case(cPar2 R')
from ‹P ⟼a[b] ≺ P'› have "P ∥ Q ⟼ a[b] ≺ P' ∥ Q" by(rule Par1F)
hence "(P ∥ Q) ∥ R ⟼ τ ≺ (P' ∥ Q) ∥ (R'[x::=b])" using ‹R ⟼a<x> ≺ R'› by (rule Comm2)
moreover from Ass have "((P' ∥ Q) ∥ R'[x::=b], P' ∥ Q ∥ (R'[x::=b])) ∈ Rel" by blast
hence "((P' ∥ Q) ∥ R'[x::=b], P' ∥ (Q ∥ R')[x::=b]) ∈ Rel" using ‹x ♯ Q› by(force simp add: forget)
ultimately show ?case by blast
qed
next
case(cClose1 P' QR a x y)
from ‹x ♯ Q ∥ R› have "x ♯ Q" by simp
from ‹y ♯ Q ∥ R› have "y ♯ Q" and "y ♯ R" by simp+
from ‹Q ∥ R ⟼ a<νy> ≺ QR› ‹y ♯ Q› ‹y ♯ R› show ?case
proof(induct rule: parCasesB)
case(cPar1 Q')
from ‹P ⟼a<x> ≺ P'› ‹Q ⟼ a<νy> ≺ Q'› ‹y ♯ P› have "P ∥ Q ⟼ τ ≺ <νy>(P'[x::=y] ∥ Q')" by(rule Close1)
hence "(P ∥ Q) ∥ R ⟼ τ ≺ (<νy>(P'[x::=y] ∥ Q')) ∥ R" by(rule Par1F)
moreover from ‹y ♯ R› have "((<νy>(P'[x::=y] ∥ Q')) ∥ R, <νy>(P'[x::=y] ∥ Q' ∥ R)) ∈ Rel"
by(rule FreshExt')
ultimately show ?case by blast
next
case(cPar2 R')
from ‹P ⟼a<x> ≺ P'› ‹x ♯ Q› have "P ∥ Q ⟼ a<x> ≺ P' ∥ Q" by(rule Par1B)
with ‹R ⟼ a<νy> ≺ R'› ‹y ♯ P› ‹y ♯ Q› have "(P ∥ Q) ∥ R ⟼ τ ≺ <νy>((P' ∥ Q)[x::=y] ∥ R')"
by(rule_tac Close1) auto
with ‹x ♯ Q› have "(P ∥ Q) ∥ R ⟼ τ ≺ <νy>((P'[x::=y] ∥ Q) ∥ R')" by(simp add: forget)
moreover have "(<νy>((P'[x::=y] ∥ Q) ∥ R'), <νy>(P'[x::=y] ∥ (Q ∥ R'))) ∈ Rel" by(metis Ass Res)
ultimately show ?case by blast
qed
next
case(cClose2 P' QR a x y)
from ‹y ♯ Q ∥ R› have "y ♯ Q" and "y ♯ R" by simp+
from ‹x ♯ Q ∥ R› have "x ♯ Q" and "x ♯ R" by simp+
with ‹Q ∥ R ⟼ a<x> ≺ QR› show ?case
proof(induct rule: parCasesB)
case(cPar1 Q')
from ‹P ⟼a<νy> ≺ P'› ‹Q ⟼a<x> ≺ Q'› have "P ∥ Q ⟼ τ ≺ <νy>(P' ∥ Q'[x::=y])" using ‹y ♯ Q›
by(rule Close2)
hence "(P ∥ Q) ∥ R ⟼ τ ≺ (<νy>(P' ∥ Q'[x::=y])) ∥ R" by(rule Par1F)
moreover from ‹y ♯ R› have "((<νy>(P' ∥ Q'[x::=y])) ∥ R, <νy>(P' ∥ (Q'[x::=y] ∥ R))) ∈ Rel"
by(rule FreshExt')
with ‹x ♯ R› have "((<νy>(P' ∥ Q'[x::=y])) ∥ R, <νy>(P' ∥ (Q' ∥ R)[x::=y])) ∈ Rel"
by(simp add: forget)
ultimately show ?case by blast
next
case(cPar2 R')
from ‹P ⟼a<νy> ≺ P'› ‹y ♯ Q› have "P ∥ Q ⟼ a<νy> ≺ P' ∥ Q" by(rule Par1B)
hence "(P ∥ Q) ∥ R ⟼ τ ≺ <νy>((P' ∥ Q) ∥ R'[x::=y])" using ‹R ⟼ a<x> ≺ R'› ‹y ♯ R› by(rule Close2)
moreover have "((P' ∥ Q) ∥ R'[x::=y], P' ∥ (Q ∥ R'[x::=y])) ∈ Rel" by(rule Ass)
hence "(<νy>((P' ∥ Q) ∥ R'[x::=y]), <νy>(P' ∥ (Q ∥ R'[x::=y]))) ∈ Rel" by(rule Res)
hence "(<νy>((P' ∥ Q) ∥ R'[x::=y]), <νy>(P' ∥ (Q ∥ R')[x::=y])) ∈ Rel" using ‹x ♯ Q›
by(simp add: forget)
ultimately show ?case by blast
qed
qed
qed
lemma substRes3:
fixes a :: name
and P :: pi
and x :: name
shows "(<νa>P)[x::=a] = <νx>([(x, a)] ∙ P)"
proof -
have "a ♯ <νa>P" by(simp add: name_fresh_abs)
hence "(<νa>P)[x::=a] = [(x, a)] ∙ <νa>P" by(rule injPermSubst[THEN sym])
thus "(<νa>P)[x::=a] = <νx>([(x, a)] ∙ P)" by(simp add: name_calc)
qed
lemma scopeExtParLeft:
fixes P :: pi
and Q :: pi
and a :: name
and lst :: "name list"
and Rel :: "(pi × pi) set"
assumes "x ♯ P"
and Id: "Id ⊆ Rel"
and EqvtRel: "eqvt Rel"
and Res: "⋀R S y. y ♯ R ⟹ (<νy>(R ∥ S), R ∥ <νy>S) ∈ Rel"
and ScopeExt: "⋀R S y z. y ♯ R ⟹ (<νy><νz>(R ∥ S), <νz>(R ∥ <νy>S)) ∈ Rel"
shows "<νx>(P ∥ Q) ↝[Rel] P ∥ <νx>Q"
using ‹eqvt Rel›
proof(induct rule: simCasesCont[where C="(x, P, Q)"])
case(Bound a y PxQ)
from ‹y ♯ (x, P, Q)› have "y ≠ x" and "y ♯ P" and "y ♯ Q" by simp+
hence "y ♯ P" and "y ♯ <νx>Q" by(simp add: abs_fresh)+
with ‹P ∥ <νx>Q ⟼ a«y» ≺ PxQ› show ?case
proof(induct rule: parCasesB)
case(cPar1 P')
from ‹P ⟼a«y» ≺ P'› ‹x ♯ P› ‹y ≠ x› have "x ♯ a" and "x ♯ P'"
by(force intro: freshBoundDerivative)+
from ‹P ⟼a«y» ≺ P'› ‹y ♯ Q› have "P ∥ Q ⟼a«y» ≺ P' ∥ Q" by(rule Par1B)
with ‹x ♯ a› ‹y ≠ x› have "<νx>(P ∥ Q) ⟼ a«y» ≺ <νx>(P' ∥ Q)" by(rule_tac ResB) auto
moreover have "derivative (<νx>(P' ∥ Q)) (P' ∥ <νx>Q) a y Rel"
proof(cases a, auto simp add: derivative_def)
fix u
show "((<νx>(P' ∥ Q))[y::=u], P'[y::=u] ∥ ((<νx>Q)[y::=u])) ∈ Rel"
proof(cases "x=u")
case True
have "(<νx>(P' ∥ Q))[y::=x] = <νy>(([(y, x)] ∙ P') ∥ ([(y, x)] ∙ Q))"
by(simp add: substRes3)
moreover from ‹x ♯ P'› have "P'[y::=x] = [(y, x)] ∙ P'" by(rule injPermSubst[THEN sym])
moreover have "(<νx>Q)[y::=x] = <νy>([(y, x)] ∙ Q)" by(rule substRes3)
moreover from ‹x ♯ P'› ‹y ≠ x› have "y ♯ [(y, x)] ∙ P'" by(simp add: name_fresh_left name_calc)
ultimately show ?thesis using ‹x = u›by(force intro: Res)
next
case False
with ‹y ≠ x› have "(<νx>(P' ∥ Q))[y::=u] = <νx>(P'[y::=u] ∥ Q[y::=u])"
by(simp add: fresh_prod name_fresh)
moreover from ‹x ≠ u› ‹y ≠ x› have "(<νx>Q)[y::=u] = <νx>(Q[y::=u])"
by(simp add: fresh_prod name_fresh)
moreover from ‹x ♯ P'› ‹x ≠ u› have "x ♯ P'[y::=u]" by(simp add: fresh_fact1)
ultimately show ?thesis by(force intro: Res)
qed
next
from ‹x ♯ P'› show "(<νx>(P' ∥ Q), P' ∥ <νx>Q) ∈ Rel" by(rule Res)
qed
ultimately show ?case by blast
next
case(cPar2 xQ)
from ‹<νx>Q ⟼a«y» ≺ xQ› ‹y ≠ x› ‹y ♯ Q› show ?case
proof(induct rule: resCasesB)
case(cOpen a Q')
from ‹Q ⟼a[x] ≺ Q'› ‹y ♯ Q› have yFreshQ': "y ♯ Q'" by(force intro: freshFreeDerivative)
from ‹Q ⟼ a[x] ≺ Q'› have "P ∥ Q ⟼ a[x] ≺ P ∥ Q'" by(rule Par2F)
hence "<νx>(P ∥ Q) ⟼ a<νx> ≺ P ∥ Q'" using ‹a ≠ x› by(rule Open)
with ‹y ♯ P› ‹y ♯ Q'› have "<νx>(P ∥ Q) ⟼ a<νy> ≺ [(x, y)] ∙ (P ∥ Q')"
by(subst alphaBoundResidual[where x'=x]) (auto simp add: fresh_left calc_atm)
with ‹y ♯ P› ‹x ♯ P› have "<νx>(P ∥ Q) ⟼ a<νy> ≺ P ∥ ([(x, y)] ∙ Q')"
by(simp add: name_fresh_fresh)
moreover have "derivative (P ∥ ([(x, y)] ∙ Q')) (P ∥ ([(y, x)] ∙ Q')) (BoundOutputS a) y Rel" using Id
by(auto simp add: derivative_def name_swap)
ultimately show ?case by blast
next
case(cRes Q')
from ‹Q ⟼ a«y» ≺ Q'› ‹y ♯ P› have "P ∥ Q ⟼ a«y» ≺ P ∥ Q'" by(rule Par2B)
hence "<νx>(P ∥ Q) ⟼ a«y» ≺ <νx>(P ∥ Q')" using ‹x ♯ a› ‹y ≠ x›
by(rule_tac ResB) auto
moreover have "derivative (<νx>(P ∥ Q')) (P ∥ <νx>Q') a y Rel"
proof(cases a, auto simp add: derivative_def)
fix u
show "((<νx>(P ∥ Q'))[y::=u], P[y::=u] ∥ (<νx>Q')[y::=u]) ∈ Rel"
proof(cases "x=u")
case True
from ‹x ♯ P› ‹y ♯ P› have "(<νx>(P ∥ Q'))[y::=x] = <νy>(P ∥ ([(y, x)] ∙ Q'))"
by(simp add: substRes3 perm_fresh_fresh)
moreover from ‹y ♯ P› have "P[y::=x] = P" by(simp add: forget)
moreover have "(<νx>Q')[y::=x] = <νy>([(y, x)] ∙ Q')" by(rule substRes3)
ultimately show ?thesis using ‹x=u› ‹y ♯ P› by(force intro: Res)
next
case False
with ‹y ≠ x› have "(<νx>(P ∥ Q'))[y::=u] = <νx>((P ∥ Q')[y::=u])"
by(simp add: fresh_prod name_fresh)
moreover from ‹y ≠ x› ‹x ≠ u› have "(<νx>Q')[y::=u] = <νx>(Q'[y::=u])"
by(simp add: fresh_prod name_fresh)
moreover from ‹x ♯ P› ‹x ≠ u› have "x ♯ P[y::=u]" by(force simp add: fresh_fact1)
ultimately show ?thesis by(force intro: Res)
qed
next
from ‹x ♯ P› show "(<νx>(P ∥ Q'), P ∥ <νx>Q') ∈ Rel" by(rule Res)
qed
ultimately show ?case by blast
qed
qed
next
case(Free α PxQ)
from ‹P ∥ <νx>Q ⟼α ≺ PxQ› show ?case
proof(induct rule: parCasesF[where C="x"])
case(cPar1 P')
from ‹P ⟼ α ≺ P'› ‹x ♯ P›have "x ♯ α" and "x ♯ P'" by(force intro: freshFreeDerivative)+
from ‹P ⟼ α ≺ P'› have "P ∥ Q ⟼ α ≺ P' ∥ Q" by(rule Par1F)
hence "<νx>(P ∥ Q) ⟼ α ≺ <νx>(P' ∥ Q)" using ‹x ♯ α› by(rule ResF)
moreover from ‹x ♯ P'› have "(<νx>(P' ∥ Q), P' ∥ <νx>Q) ∈ Rel" by(rule Res)
ultimately show ?case by blast
next
case(cPar2 Q')
from ‹<νx>Q ⟼ α ≺ Q'› show ?case
proof(induct rule: resCasesF)
case(cRes Q')
from ‹Q ⟼ α ≺ Q'› have "P ∥ Q ⟼ α ≺ P ∥ Q'" by(rule Par2F)
hence "<νx>(P ∥ Q) ⟼α ≺ <νx>(P ∥ Q')" using ‹x ♯ α› by(rule ResF)
moreover from ‹x ♯ P› have "(<νx>(P ∥ Q'), P ∥ <νx>Q') ∈ Rel" by(rule Res)
ultimately show ?case by blast
qed
next
case(cComm1 P' xQ a b y)
from ‹y ♯ x› have "y ≠ x" by simp
from ‹P ⟼ a<y> ≺ P'› ‹x ♯ P› ‹y ≠ x› have "x ♯ P'" by(force intro: freshBoundDerivative)
from ‹<νx>Q ⟼a[b] ≺ xQ› show ?case
proof(induct rule: resCasesF)
case(cRes Q')
from ‹x ♯ a[b]› have "x ≠ b" by simp
from ‹P ⟼ a<y> ≺ P'› ‹Q ⟼ a[b] ≺ Q'› have "P ∥ Q ⟼ τ ≺ P'[y::=b] ∥ Q'" by(rule Comm1)
hence "<νx>(P ∥ Q) ⟼ τ ≺ <νx>(P'[y::=b] ∥ Q')" by(rule_tac ResF) auto
moreover from ‹x ♯ P'› ‹x ≠ b› have "x ♯ P'[y::=b]" by(force intro: fresh_fact1)
hence "(<νx>(P'[y::=b] ∥ Q'), P'[y::=b] ∥ <νx>Q') ∈ Rel" by(rule Res)
ultimately show ?case by blast
qed
next
case(cComm2 P' xQ a b y)
from ‹y ♯ x› ‹y ♯ <νx>Q› have "y ≠ x" and "y ♯ Q" by(simp add: abs_fresh)+
with ‹<νx>Q ⟼a<y> ≺ xQ› show ?case
proof(induct rule: resCasesB)
case(cOpen b Q')
from ‹InputS a = BoundOutputS b› have False by simp
thus ?case by simp
next
case(cRes Q')
from ‹P ⟼a[b] ≺ P'› ‹Q ⟼a<y> ≺ Q'› have "P ∥ Q ⟼ τ ≺ P' ∥ Q'[y::=b]" by(rule Comm2)
hence "<νx>(P ∥ Q) ⟼ τ ≺ <νx>(P' ∥ Q'[y::=b])" by(rule_tac ResF) auto
moreover from ‹P ⟼a[b] ≺ P'› ‹x ♯ P› have "x ♯ P'" and "x ≠ b" by(force dest: freshFreeDerivative)+
from ‹x ♯ P'› have "(<νx>(P' ∥ Q'[y::=b]), P' ∥ <νx>(Q'[y::=b])) ∈ Rel" by(rule Res)
with ‹y ≠ x› ‹x ≠ b› have "(<νx>(P' ∥ Q'[y::=b]), P' ∥ (<νx>Q')[y::=b]) ∈ Rel" by simp
ultimately show ?case by blast
qed
next
case(cClose1 P' Q' a y z)
from ‹y ♯ x› have "y ≠ x" by simp
from ‹z ♯ x› ‹z ♯ <νx>Q› have "z ♯ Q" and "z ≠ x" by(simp add: abs_fresh)+
from ‹P ⟼a<y> ≺ P'› ‹z ♯ P› have "z ≠ a" by(force dest: freshBoundDerivative)
from ‹<νx>Q ⟼ a<νz> ≺ Q'› ‹z ≠ x› ‹z ♯ Q› show ?case
proof(induct rule: resCasesB)
case(cOpen b Q')
from ‹BoundOutputS a = BoundOutputS b› have "a = b" by simp
with ‹Q ⟼ b[x] ≺ Q'› have "([(z, x)] ∙ Q) ⟼ [(z, x)] ∙ (a[x] ≺ Q')"
by(rule_tac transitions.eqvt) simp
with ‹b ≠ x› ‹z ≠ a› ‹a = b› ‹z ≠ x› have "([(z, x)] ∙ Q) ⟼ a[z] ≺ ([(z, x)] ∙ Q')"
by(simp add: name_calc eqvts)
with ‹P ⟼a<y> ≺ P'› have "P ∥ ([(z, x)] ∙ Q) ⟼τ ≺ P'[y::=z] ∥ ([(z, x)] ∙ Q')"
by(rule Comm1)
hence "<νz>(P ∥ ([(x, z)] ∙ Q)) ⟼ τ ≺ <νz>(P'[y::=z] ∥ ([(z, x)] ∙ Q'))"
by(rule_tac ResF) auto
hence "<νx>(P ∥ Q) ⟼ τ ≺ <νz>(P'[y::=z] ∥ ([(z, x)] ∙ Q'))" using ‹z ♯ P› ‹z ♯ Q› ‹x ♯ P›
by(subst alphaRes[where c=z]) auto
with Id show ?case by force
next
case(cRes Q')
from ‹P ⟼a<y> ≺ P'› ‹Q ⟼a<νz> ≺ Q'› ‹z ♯ P› have "P ∥ Q ⟼ τ ≺ <νz>(P'[y::=z] ∥ Q')"
by(rule Close1)
hence "<νx>(P ∥ Q) ⟼ τ ≺ <νx><νz>(P'[y::=z] ∥ Q')" by(rule_tac ResF) auto
moreover from ‹P ⟼a<y> ≺ P'› ‹y ≠ x› ‹x ♯ P› have "x ♯ P'"
by(force dest: freshBoundDerivative)
with ‹z ≠ x› have "x ♯ P'[y::=z]" by(simp add: fresh_fact1)
hence "(<νx><νz>(P'[y::=z] ∥ Q'), <νz>(P'[y::=z] ∥ <νx>Q')) ∈ Rel"
by(rule ScopeExt)
ultimately show ?case by blast
qed
next
case(cClose2 P' xQ a y z)
from ‹z ♯ x› ‹z ♯ <νx>Q› have "z ≠ x" and "z ♯ Q" by(auto simp add: abs_fresh)
from ‹y ♯ x› ‹y ♯ <νx>Q› have "y ≠ x" and "y ♯ Q" by(auto simp add: abs_fresh)
with ‹<νx>Q ⟼a<y> ≺ xQ› show ?case
proof(induct rule: resCasesB)
case(cOpen b Q')
from ‹InputS a = BoundOutputS b› have False by simp
thus ?case by simp
next
case(cRes Q')
from ‹P ⟼a<νz> ≺ P'› ‹Q ⟼a<y> ≺ Q'› ‹z ♯ Q› have "P ∥ Q ⟼ τ ≺ <νz>(P' ∥ Q'[y::=z])"
by(rule Close2)
hence "<νx>(P ∥ Q) ⟼ τ ≺ <νx><νz>(P' ∥ (Q'[y::=z]))"
by(rule_tac ResF) auto
moreover from ‹P ⟼a<νz> ≺ P'› ‹x ♯ P› ‹z ≠ x› have "x ♯ P'" by(force dest: freshBoundDerivative)
hence "(<νx><νz>(P' ∥ (Q'[y::=z])), <νz>(P' ∥ (<νx>(Q'[y::=z])))) ∈ Rel"
by(rule ScopeExt)
with ‹z ≠ x› ‹y ≠ x› have "(<νx><νz>(P' ∥ (Q'[y::=z])), <νz>(P' ∥ (<νx>Q')[y::=z])) ∈ Rel"
by simp
ultimately show ?case by blast
qed
qed
qed
lemma scopeExtParRight:
fixes P :: pi
and Q :: pi
and a :: name
and Rel :: "(pi × pi) set"
assumes "x ♯ P"
and Id: "Id ⊆ Rel"
and "eqvt Rel"
and Res: "⋀R S y. y ♯ R ⟹ (R ∥ <νy>S, <νy>(R ∥ S)) ∈ Rel"
and ScopeExt: "⋀R S y z. y ♯ R ⟹ (<νz>(R ∥ <νy>S), <νy><νz>(R ∥ S)) ∈ Rel"
shows "P ∥ <νx>Q ↝[Rel] <νx>(P ∥ Q)"
using ‹eqvt Rel›
proof(induct rule: simCasesCont[where C="(x, P, Q)"])
case(Bound a y xPQ)
from ‹y ♯ (x, P, Q)› have "y ≠ x" and "y ♯ P" and "y ♯ Q" by simp+
hence "y ≠ x" and "y ♯ P ∥ Q" by(auto simp add: abs_fresh)
with ‹<νx>(P ∥ Q) ⟼a«y» ≺ xPQ› show ?case
proof(induct rule: resCasesB)
case(cOpen a PQ)
from ‹P ∥ Q ⟼a[x] ≺ PQ› show ?case
proof(induct rule: parCasesF[where C="()"])
case(cPar1 P')
from ‹P ⟼a[x] ≺ P'› ‹x ♯ P› have "x ≠ x" by(force dest: freshFreeDerivative)
thus ?case by simp
next
case(cPar2 Q')
from ‹Q ⟼a[x] ≺ Q'› ‹y ♯ Q› have "y ♯ Q'" by(force dest: freshFreeDerivative)
from ‹Q ⟼a[x] ≺ Q'› ‹a ≠ x› have "<νx>Q ⟼a<νx> ≺ Q'" by(rule Open)
hence "P ∥ <νx>Q ⟼a<νx> ≺ P ∥ Q'" using ‹x ♯ P› by(rule Par2B)
with ‹y ♯ P› ‹y ♯ Q'› ‹x ♯ P› have "P ∥ <νx>Q ⟼a<νy> ≺ ([(y, x)] ∙ (P ∥ Q'))"
by(subst alphaBoundResidual[where x'=x]) (auto simp add: fresh_left calc_atm)
moreover with Id have "derivative ([(y, x)] ∙ (P ∥ Q'))
([(y, x)] ∙ (P ∥ Q')) (BoundOutputS a) y Rel"
by(auto simp add: derivative_def)
ultimately show ?case by blast
next
case(cComm1 P' Q' b c y)
from ‹a[x] = τ› show ?case by simp
next
case(cComm2 P' Q' b c y)
from ‹a[x] = τ› show ?case by simp
next
case(cClose1 P' Q' b y z)
from ‹a[x] = τ› show ?case by simp
next
case(cClose2 P' Q' b y z)
from ‹a[x] = τ› show ?case by simp
qed
next
case(cRes PQ)
from ‹P ∥ Q ⟼a«y» ≺ PQ› ‹y ♯ P› ‹y ♯ Q›
show ?case
proof(induct rule: parCasesB)
case(cPar1 P')
from ‹y ≠ x› ‹x ♯ P› ‹P ⟼a«y» ≺ P'› have "x ♯ P'" by(force dest: freshBoundDerivative)
from ‹P ⟼a«y» ≺ P'› ‹y ♯ Q› have "P ∥ <νx>Q ⟼a«y» ≺ P' ∥ <νx>Q"
by(rule_tac Par1B) (auto simp add: abs_fresh)
moreover have "derivative (P' ∥ <νx>Q) (<νx>(P' ∥ Q)) a y Rel"
proof(cases a, auto simp add: derivative_def)
fix u::name
obtain z::name where "z ♯ Q" and "y ≠ z" and "z ≠ u" and "z ♯ P" and "z ♯ P'"
by(generate_fresh "name") auto
thus "(P'[y::=u] ∥ (<νx>Q)[y::=u], (<νx>(P' ∥ Q))[y::=u]) ∈ Rel" using ‹x ♯ P'›
by(subst alphaRes[where c=z and a=x], auto)
(subst alphaRes[where c=z and a=x], auto intro: Res simp add: fresh_fact1)
next
from ‹x ♯ P'› show "(P' ∥ <νx>Q, <νx>(P' ∥ Q)) ∈ Rel"
by(rule Res)
qed
ultimately show ?case by blast
next
case(cPar2 Q')
from ‹Q ⟼a«y» ≺ Q'› have "<νx>Q ⟼a«y» ≺ <νx>Q'" using ‹x ♯ a› ‹y ≠ x›
by(rule_tac ResB) auto
hence "P ∥ <νx>Q ⟼a«y» ≺ P ∥ <νx>Q'" using ‹y ♯ P› by(rule Par2B)
moreover have "derivative (P ∥ <νx>Q') (<νx>(P ∥ Q')) a y Rel"
proof(cases a, auto simp add: derivative_def)
fix u::name
obtain z::name where "z ♯ Q" and "z ≠ y" and "z ≠ u" and "z ♯ P" and "z ♯ Q'"
by(generate_fresh "name") auto
thus "(P[y::=u] ∥ (<νx>Q')[y::=u], (<νx>(P ∥ Q'))[y::=u]) ∈ Rel" using ‹x ♯ P›
by(subst alphaRes[where a=x and c=z], auto)
(subst alphaRes[where a=x and c=z], auto intro: Res simp add: fresh_fact1)
next
from ‹x ♯ P› show "(P ∥ <νx>Q', <νx>(P ∥ Q')) ∈ Rel"
by(rule Res)
qed
ultimately show ?case by blast
qed
qed
next
case(Free α xPQ)
from ‹<νx>(P ∥ Q) ⟼α ≺ xPQ› show ?case
proof(induct rule: resCasesF)
case(cRes PQ)
from ‹P ∥ Q ⟼α ≺ PQ› show ?case
proof(induct rule: parCasesF[where C="x"])
case(cPar1 P')
from ‹P ⟼α ≺ P'› have "P ∥ <νx>Q ⟼α ≺ P' ∥ <νx>Q" by(rule Par1F)
moreover from ‹P ⟼α ≺ P'› ‹x ♯ P› have "x ♯ P'" by(rule freshFreeDerivative)
hence "(P' ∥ <νx>Q, <νx>(P' ∥ Q)) ∈ Rel" by(rule Res)
ultimately show ?case by blast
next
case(cPar2 Q')
from ‹Q ⟼α ≺ Q'› ‹x ♯ α› have "<νx>Q ⟼α ≺ <νx>Q'" by(rule ResF)
hence "P ∥ <νx>Q ⟼α ≺ P ∥ <νx>Q'" by(rule Par2F)
moreover from ‹x ♯ P› have "(P ∥ <νx>Q', <νx>(P ∥ Q')) ∈ Rel" by(rule Res)
ultimately show ?case by blast
next
case(cComm1 P' Q' a b y)
from ‹x ♯ P› ‹y ♯ x› ‹P ⟼a<y> ≺ P'› have "x ≠ a" and "x ♯ P'" by(force dest: freshBoundDerivative)+
show ?case
proof(cases "b=x")
case True
from ‹Q ⟼a[b] ≺ Q'› ‹x ≠ a› ‹b = x› have "<νx>Q ⟼a<νx> ≺ Q'" by(rule_tac Open) auto
with ‹P ⟼a<y> ≺ P'› have "P ∥ <νx>Q ⟼τ ≺ <νx>(P'[y::=x] ∥ Q')" using ‹x ♯ P› by(rule Close1)
moreover from Id have "(<νx>(P'[y::=b] ∥ Q'), <νx>(P'[y::=b] ∥ Q')) ∈ Rel" by blast
ultimately show ?thesis using ‹b=x› by blast
next
case False
from ‹Q ⟼a[b] ≺ Q'› ‹x ≠ a› ‹b ≠ x› have "<νx>Q ⟼a[b] ≺ <νx>Q'" by(rule_tac ResF) auto
with ‹P ⟼a<y> ≺ P'› have "P ∥ <νx>Q ⟼τ ≺ (P'[y::=b] ∥ <νx>Q')" by(rule Comm1)
moreover from ‹x ♯ P'› ‹b ≠ x› have "(P'[y::=b] ∥ <νx>Q', <νx>(P'[y::=b] ∥ Q')) ∈ Rel"
by(force intro: Res simp add: fresh_fact1)
ultimately show ?thesis by blast
qed
next
case(cComm2 P' Q' a b y)
from ‹P ⟼a[b] ≺ P'› ‹x ♯ P› have "x ≠ a" and "x ≠ b" and "x ♯ P'" by(force dest: freshFreeDerivative)+
from ‹Q ⟼a<y> ≺ Q'› ‹y ♯ x› ‹x ≠ a› have "<νx>Q ⟼a<y> ≺ <νx>Q'" by(rule_tac ResB) auto
with ‹P ⟼a[b] ≺ P'› have "P ∥ <νx>Q ⟼τ ≺ P' ∥ (<νx>Q')[y::=b]" by(rule Comm2)
moreover from ‹x ♯ P'› have "(P' ∥ <νx>(Q'[y::=b]), <νx>(P' ∥ Q'[y::=b])) ∈ Rel" by(rule Res)
ultimately show ?case using ‹y ♯ x› ‹x ≠ b› by force
next
case(cClose1 P' Q' a y z)
from ‹P ⟼a<y> ≺ P'› ‹x ♯ P› ‹y ♯ x› have "x ≠ a" and "x ♯ P'" by(force dest: freshBoundDerivative)+
from ‹Q ⟼a<νz> ≺ Q'› ‹z ♯ x› ‹x ≠ a› have "<νx>Q ⟼a<νz> ≺ <νx>Q'" by(rule_tac ResB) auto
with ‹P ⟼a<y> ≺ P'› have "P ∥ <νx>Q ⟼τ ≺ <νz>(P'[y::=z] ∥ <νx>Q')" using ‹z ♯ P› by(rule Close1)
moreover from ‹x ♯ P'› ‹z ♯ x› have "(<νz>(P'[y::=z] ∥ <νx>Q'), <νx>(<νz>(P'[y::=z] ∥ Q'))) ∈ Rel"
by(rule_tac ScopeExt) (auto simp add: fresh_fact1)
ultimately show ?case by blast
next
case(cClose2 P' Q' a y z)
from ‹P ⟼a<νz> ≺ P'› ‹x ♯ P› ‹z ♯ x› have "x ≠ a" and "x ♯ P'" by(force dest: freshBoundDerivative)+
from ‹Q ⟼a<y> ≺ Q'› ‹y ♯ x› ‹x ≠ a› have "<νx>Q ⟼a<y> ≺ <νx>Q'" by(rule_tac ResB) auto
with ‹P ⟼a<νz> ≺ P'› have "P ∥ <νx>Q ⟼τ ≺ <νz>(P' ∥ (<νx>Q')[y::=z])" using ‹z ♯ Q›
by(rule_tac Close2) (auto simp add: abs_fresh)
moreover from ‹x ♯ P'› have "(<νz>(P' ∥ <νx>(Q'[y::=z])), <νx><νz>(P' ∥ Q'[y::=z])) ∈ Rel" by(rule ScopeExt)
ultimately show ?case using ‹z ♯ x› ‹y ♯ x› by force
qed
qed
qed
lemma resNilRight:
fixes x :: name
and Rel :: "(pi × pi) set"
shows "𝟬 ↝[Rel] <νx>𝟬"
by(fastforce simp add: simulation_def pi.inject alpha' elim: resCasesB' resCasesF)
lemma resComm:
fixes a :: name
and b :: name
and P :: pi
and Rel :: "(pi × pi) set"
assumes ResComm: "⋀c d Q. (<νc><νd>Q, <νd><νc>Q) ∈ Rel"
and Id: "Id ⊆ Rel"
and EqvtRel: "eqvt Rel"
shows "<νa><νb>P ↝[Rel] <νb><νa>P"
proof(cases "a=b")
assume "a=b"
with Id show ?thesis by(force intro: Strong_Late_Sim.reflexive)
next
assume aineqb: "a ≠ b"
from EqvtRel show ?thesis
proof(induct rule: simCasesCont[where C="(a, b, P)"])
case(Bound c x baP)
from ‹x ♯ (a, b, P)› have "x ≠ a" and "x ≠ b" and "x ♯ P" by simp+
from ‹x ♯ P› have "x ♯ <νa>P" by(simp add: abs_fresh)
with ‹<νb><νa>P ⟼ c«x» ≺ baP› ‹x ≠ b› show ?case
proof(induct rule: resCasesB)
case(cOpen c aP)
from ‹<νa>P ⟼c[b] ≺ aP›
show ?case
proof(induct rule: resCasesF)
case(cRes P')
from ‹a ♯ c[b]› have "a ≠ c" and "a ≠ b" by simp+
from ‹x ♯ P› ‹P ⟼c[b] ≺ P'› have "x ≠ c" and "x ♯ P'" by(force dest: freshFreeDerivative)+
from ‹P ⟼ c[b] ≺ P'› have "([(x, b)] ∙ P) ⟼ [(x, b)] ∙ (c[b] ≺ P')" by(rule transitions.eqvt)
with ‹x ≠ c› ‹c ≠ b› ‹x ≠ b› have "([(x, b)] ∙ P) ⟼ c[x] ≺ [(x, b)] ∙ P'" by(simp add: eqvts calc_atm)
hence "<νx>([(x, b)] ∙ P) ⟼ c<νx> ≺ [(x, b)] ∙ P'" using ‹x ≠ c› by(rule_tac Open) auto
with ‹x ♯ P› have "<νb>P ⟼ c<νx> ≺ [(x, b)] ∙ P'" by(simp add: alphaRes)
hence "<νa><νb>P ⟼ c<νx> ≺ <νa>([(x, b)] ∙ P')" using ‹a ≠ c› ‹x ≠ a›
by(rule_tac ResB) auto
moreover from Id have "derivative (<νa>([(x, b)] ∙ P')) (<νa>([(x, b)] ∙ P')) (BoundOutputS c) x Rel"
by(force simp add: derivative_def)
ultimately show ?case using ‹a ≠ b› ‹x ≠ a› ‹a ≠ c› by(force simp add: eqvts calc_atm)
qed
next
case(cRes aP)
from ‹<νa>P ⟼ c«x» ≺ aP› ‹x ≠ a› ‹x ♯ P› ‹b ♯ c› show ?case
proof(induct rule: resCasesB)
case(cOpen c P')
from ‹P ⟼c[a] ≺ P'› ‹x ♯ P› have "x ♯ P'" by(force intro: freshFreeDerivative)
from ‹b ♯ BoundOutputS c› have "b ≠ c" by simp
with ‹P ⟼c[a] ≺ P'› ‹a ≠ b› have "<νb>P ⟼ c[a] ≺ <νb>P'" by(rule_tac ResF) auto
with ‹c ≠ a› have "<νa><νb>P ⟼ c<νa> ≺ <νb>P'" by(rule_tac Open) auto
hence "<νa><νb>P ⟼c<νx> ≺ <νb>([(x, a)] ∙ P')" using ‹x ≠ b› ‹a ≠ b› ‹x ♯ P'›
apply(subst alphaBoundResidual[where x'=a]) by(auto simp add: abs_fresh fresh_left calc_atm)
moreover have "derivative (<νb>([(x, a)] ∙ P')) (<νb>([(x, a)] ∙ P')) (BoundOutputS c) x Rel" using Id
by(force simp add: derivative_def)
ultimately show ?case by blast
next
case(cRes P')
from ‹P ⟼c«x» ≺ P'› ‹b ♯ c› ‹x ≠ b› have "<νb>P ⟼ c«x» ≺ <νb>P'" by(rule_tac ResB) auto
hence "<νa><νb>P ⟼ c«x» ≺ <νa><νb>P'" using ‹a ♯ c› ‹x ≠ a› by(rule_tac ResB) auto
moreover have "derivative (<νa><νb>P') (<νb><νa>P') c x Rel"
proof(cases c, auto simp add: derivative_def)
fix u::name
show "((<νa><νb>P')[x::=u], (<νb><νa>P')[x::=u]) ∈ Rel"
proof(cases "u=a")
case True
from ‹u = a› ‹a ≠ b› show ?thesis
by(subst injPermSubst[symmetric], auto simp add: abs_fresh)
(subst injPermSubst[symmetric], auto simp add: abs_fresh calc_atm intro: ResComm)
next
case False
show ?thesis
proof(cases "u=b")
case True
from ‹u = b› ‹u ≠ a› show ?thesis
by(subst injPermSubst[symmetric], auto simp add: abs_fresh)
(subst injPermSubst[symmetric], auto simp add: abs_fresh calc_atm intro: ResComm)
next
case False
from ‹u ≠ a› ‹u ≠ b› ‹x ≠ a› ‹x ≠ b› show ?thesis by(auto intro: ResComm)
qed
qed
next
show "(<νa><νb>P', <νb><νa>P') ∈ Rel" by(rule ResComm)
qed
ultimately show ?case by blast
qed
qed
next
case(Free α baP)
from ‹<νb><νa>P ⟼ α ≺ baP› show ?case
proof(induct rule: resCasesF)
case(cRes aP)
from ‹<νa>P ⟼ α ≺ aP› show ?case
proof(induct rule: resCasesF)
case(cRes P')
from ‹P ⟼ α ≺ P'› ‹b ♯ α› have "<νb>P ⟼ α ≺ <νb>P'" by(rule ResF)
hence "<νa><νb>P ⟼ α ≺ <νa><νb>P'" using ‹a ♯ α› by(rule ResF)
moreover have "(<νa><νb>P', <νb><νa>P') ∈ Rel" by(rule ResComm)
ultimately show ?case by blast
qed
qed
qed
qed
lemma bangLeftSC:
fixes P :: pi
and Rel :: "(pi × pi) set"
assumes "Id ⊆ Rel"
shows "!P ↝[Rel] P ∥ !P"
using assms
by(force simp add: simulation_def dest: Bang derivativeReflexive)
lemma bangRightSC:
fixes P :: pi
and Rel :: "(pi × pi) set"
assumes IdRel: "Id ⊆ Rel"
shows "P ∥ !P ↝[Rel] !P"
using assms
by(fastforce simp add: pi.inject simulation_def intro: derivativeReflexive elim: bangCases)
lemma resNilLeft:
fixes x :: name
and y :: name
and P :: pi
and Rel :: "(pi × pi) set"
and b :: name
shows "𝟬 ↝[Rel] <νx>(x<y>.P)"
and "𝟬 ↝[Rel] <νx>(x{b}.P)"
by(auto simp add: simulation_def)
lemma resInputLeft:
fixes x :: name
and a :: name
and y :: name
and P :: pi
and Rel :: "(pi × pi) set"
assumes xineqa: "x ≠ a"
and xineqy: "x ≠ y"
and Eqvt: "eqvt Rel"
and Id: "Id ⊆ Rel"
shows "<νx>a<y>.P ↝[Rel] a<y>.(<νx>P)"
using Eqvt
proof(induct rule: simCasesCont[where C="(x, y, a, P)"])
case(Bound b z P')
from ‹z ♯ (x, y, a, P)› have "z ≠ x" and "z ≠ y" and "z ♯ P" and "z ≠ a" by simp+
from ‹z ♯ P› have "z ♯ <νx>P" by(simp add: abs_fresh)
with ‹a<y>.(<νx>P) ⟼b«z» ≺ P'› ‹z ≠ a› ‹z ≠ y› show ?case
proof(induct rule: inputCases)
case cInput
have "a<y>.P ⟼a<y> ≺ P" by(rule Input)
with ‹x ≠ y› ‹x ≠ a› have "<νx>a<y>.P ⟼a<y> ≺ <νx>P" by(rule_tac ResB) auto
hence "<νx>a<y>.P ⟼a<z> ≺ [(y, z)] ∙ <νx>P" using ‹z ♯ P›
by(subst alphaBoundResidual[where x'=y]) (auto simp add: abs_fresh fresh_left calc_atm)
moreover from Id have "derivative ([(y, z)] ∙ <νx>P) ([(y, z)] ∙ <νx>P) (InputS a) z Rel"
by(rule derivativeReflexive)
ultimately show ?case by blast
qed
next
case(Free α P')
from ‹a<y>.(<νx>P) ⟼α ≺ P'› have False by auto
thus ?case by simp
qed
lemma resInputRight:
fixes a :: name
and y :: name
and x :: name
and P :: pi
and Rel :: "(pi × pi) set"
assumes xineqa: "x ≠ a"
and xineqy: "x ≠ y"
and Eqvt: "eqvt Rel"
and Id: "Id ⊆ Rel"
shows "a<y>.(<νx>P) ↝[Rel] <νx>a<y>.P"
using Eqvt
proof(induct rule: simCasesCont[where C="(x, y, a, P)"])
case(Bound b z xP)
from ‹z ♯ (x, y, a, P)› have "z ≠ x" and "z ≠ y" and "z ♯ P" and "z ≠ a" by simp+
from ‹z ≠ a› ‹z ♯ P› have "z ♯ a<y>.P" by(simp add: abs_fresh)
with ‹<νx>a<y>.P ⟼b«z» ≺ xP› ‹z ≠ x› show ?case
proof(induct rule: resCasesB)
case(cOpen b P')
from ‹a<y>.P ⟼b[x] ≺ P'› have False by auto
thus ?case by simp
next
case(cRes P')
from ‹a<y>.P ⟼b«z» ≺ P'›‹z ≠ a› ‹z ≠ y› ‹z ♯ P› show ?case
proof(induct rule: inputCases)
case cInput
have "a<y>.(<νx>P) ⟼a<y> ≺ (<νx>P)" by(rule Input)
with ‹z ♯ P› ‹x ≠ y› ‹z ≠ x› have "a<y>.(<νx>P) ⟼a<z> ≺ (<νx>([(y, z)] ∙ P))"
by(subst alphaBoundResidual[where x'=y]) (auto simp add: abs_fresh calc_atm fresh_left)
moreover from Id have "derivative (<νx>([(y, z)] ∙ P)) (<νx>([(y, z)] ∙ P)) (InputS a) z Rel"
by(rule derivativeReflexive)
ultimately show ?case by blast
qed
qed
next
case(Free α P')
from ‹<νx>a<y>.P ⟼α ≺ P'› have False by auto
thus ?case by simp
qed
lemma resOutputLeft:
fixes x :: name
and a :: name
and b :: name
and P :: pi
and Rel :: "(pi × pi) set"
assumes xineqa: "x ≠ a"
and xineqb: "x ≠ b"
and Id: "Id ⊆ Rel"
shows "<νx>a{b}.P ↝[Rel] a{b}.(<νx>P)"
using assms
by(fastforce simp add: simulation_def elim: outputCases intro: Output ResF)
lemma resOutputRight:
fixes x :: name
and a :: name
and b :: name
and P :: pi
and Rel :: "(pi × pi) set"
assumes xineqa: "x ≠ a"
and xineqb: "x ≠ b"
and Id: "Id ⊆ Rel"
and Eqvt: "eqvt Rel"
shows "a{b}.(<νx>P) ↝[Rel] <νx>a{b}.P"
using assms
by(erule_tac simCasesCont[where C=x])
(force simp add: abs_fresh elim: resCasesB resCasesF outputCases intro: ResF Output)+
lemma resTauLeft:
fixes x :: name
and P :: pi
and Rel :: "(pi × pi) set"
assumes Id: "Id ⊆ Rel"
shows "<νx>(τ.(P)) ↝[Rel] τ.(<νx>P)"
using assms
by(force simp add: simulation_def elim: tauCases resCasesF intro: Tau ResF)
lemma resTauRight:
fixes x :: name
and P :: pi
and Rel :: "(pi × pi) set"
assumes Id: "Id ⊆ Rel"
shows "τ.(<νx>P) ↝[Rel] <νx>(τ.(P))"
using assms
by(force simp add: simulation_def elim: tauCases resCasesF intro: Tau ResF)
end
Theory Strong_Late_Bisim_SC
theory Strong_Late_Bisim_SC
imports Strong_Late_Bisim_Pres Strong_Late_Sim_SC
begin
lemma nilBisim[dest]:
fixes a :: name
and b :: name
and x :: name
and P :: pi
shows "τ.(P) ∼ 𝟬 ⟹ False"
and "a<x>.P ∼ 𝟬 ⟹ False"
and "a{b}.P ∼ 𝟬 ⟹ False"
and "𝟬 ∼ τ.(P) ⟹ False"
and "𝟬 ∼ a<x>.P ⟹ False"
and "𝟬 ∼ a{b}.P ⟹ False"
by(auto dest: bisimE symmetric)
lemma matchId:
fixes a :: name
and P :: pi
shows "[a⌢a]P ∼ P"
proof -
let ?X = "{([a⌢a]P, P), (P, [a⌢a]P)}"
have "([a⌢a]P, P) ∈ ?X" by simp
thus ?thesis
by(coinduct rule: bisimCoinduct) (auto intro: matchIdLeft matchIdRight reflexive)
qed
lemma matchNil:
fixes a :: name
and b :: name
assumes "a ≠ b"
shows "[a⌢b]P ∼ 𝟬"
proof -
let ?X = "{([a⌢b]P, 𝟬), (𝟬, [a⌢b]P)}"
have "([a⌢b]P, 𝟬) ∈ ?X" by simp
thus ?thesis using ‹a ≠ b›
by(coinduct rule: bisimCoinduct) (auto intro: matchNilLeft nilSimRight reflexive)
qed
lemma mismatchId:
fixes a :: name
and b :: name
and P :: pi
assumes "a ≠ b"
shows "[a≠b]P ∼ P"
proof -
let ?X = "{([a≠b]P, P), (P, [a≠b]P)}"
have "([a≠b]P, P) ∈ ?X" by simp
thus ?thesis using ‹a ≠ b›
by(coinduct rule: bisimCoinduct) (auto intro: mismatchIdLeft mismatchIdRight reflexive)
qed
lemma mismatchNil:
fixes a :: name
and P :: pi
shows "[a≠a]P ∼ 𝟬"
proof -
let ?X = "{([a≠a]P, 𝟬), (𝟬, [a≠a]P)}"
have "([a≠a]P, 𝟬) ∈ ?X" by simp
thus ?thesis
by(coinduct rule: bisimCoinduct) (auto intro: mismatchNilLeft nilSimRight reflexive)
qed
lemma nilRes:
fixes x :: name
shows "<νx>𝟬 ∼ 𝟬"
proof -
let ?X = "{(<νx>𝟬, 𝟬), (𝟬, <νx>𝟬)}"
have "(<νx>𝟬, 𝟬) ∈ ?X" by simp
thus ?thesis
by(coinduct rule: bisimCoinduct) (auto intro: nilSimRight resNilRight)
qed
lemma resComm:
fixes x :: name
and y :: name
and P :: pi
shows "<νx><νy>P ∼ <νy><νx>P"
proof -
let ?X = "{(<νx><νy>P, <νy><νx>P) | x y P. True}"
have "(<νx><νy>P, <νy><νx>P) ∈ ?X" by auto
thus ?thesis
proof(coinduct rule: bisimCoinduct)
case(cSim xyP yxP)
{
fix x y P
have "⋀x y P. (<νx><νy>P, <νy><νx>P) ∈ ?X ∪ bisim" by auto
moreover have "Id ⊆ ?X ∪ bisim" by(auto intro: reflexive)
moreover have "eqvt ?X" by(force simp add: eqvt_def)
hence "eqvt(?X ∪ bisim)" by auto
ultimately have "<νx><νy>P ↝[(?X ∪ bisim)] <νy><νx>P" by(rule resComm)
}
with ‹(xyP, yxP) ∈ ?X› show ?case by auto
next
case(cSym xyP yxP)
thus ?case by auto
qed
qed
lemma sumSym:
fixes P :: pi
and Q :: pi
shows "P ⊕ Q ∼ Q ⊕ P"
proof -
let ?X = "{(P ⊕ Q, Q ⊕ P), (Q ⊕ P, P ⊕ Q)}"
have "(P ⊕ Q, Q ⊕ P) ∈ ?X" by simp
thus ?thesis
by(coinduct rule: bisimCoinduct) (auto intro: reflexive sumSym)
qed
lemma sumIdemp:
fixes P :: pi
shows "P ⊕ P ∼ P"
proof -
let ?X = "{(P ⊕ P, P), (P, P ⊕ P)}"
have "(P ⊕ P, P) ∈ ?X" by simp
thus ?thesis
by(coinduct rule: bisimCoinduct) (auto intro: reflexive sumIdempLeft sumIdempRight)
qed
lemma sumAssoc:
fixes P :: pi
and Q :: pi
and R :: pi
shows "(P ⊕ Q) ⊕ R ∼ P ⊕ (Q ⊕ R)"
proof -
let ?X = "{((P ⊕ Q) ⊕ R, P ⊕ (Q ⊕ R)), (P ⊕ (Q ⊕ R), (P ⊕ Q) ⊕ R)}"
have "((P ⊕ Q) ⊕ R, P ⊕ (Q ⊕ R)) ∈ ?X" by simp
thus ?thesis
by(coinduct rule: bisimCoinduct) (auto intro: reflexive sumAssocLeft sumAssocRight)
qed
lemma sumZero:
fixes P :: pi
shows "P ⊕ 𝟬 ∼ P"
proof -
let ?X = "{(P ⊕ 𝟬, P), (P, P ⊕ 𝟬)}"
have "(P ⊕ 𝟬, P) ∈ ?X" by simp
thus ?thesis
by(coinduct rule: bisimCoinduct) (auto intro: reflexive sumZeroLeft sumZeroRight)
qed
lemma parZero:
fixes P :: pi
shows "P ∥ 𝟬 ∼ P"
proof -
let ?X = "{(P ∥ 𝟬, P) | P. True} ∪ {(P, P ∥ 𝟬) | P . True}"
have "(P ∥ 𝟬, P) ∈ ?X" by blast
thus ?thesis
by(coinduct rule: bisimCoinduct, auto intro: parZeroRight parZeroLeft)
qed
lemma parSym:
fixes P :: pi
and Q :: pi
shows "P ∥ Q ∼ Q ∥ P"
proof -
let ?X = "{(resChain lst (P ∥ Q), resChain lst (Q ∥ P)) | lst P Q. True}"
have "(P ∥ Q, Q ∥ P) ∈ ?X" by(blast intro: resChain.base[THEN sym])
thus ?thesis
proof(coinduct rule: bisimCoinduct)
case(cSim PQ QP)
{
fix lst P Q
have "⋀P Q. (P ∥ Q, Q ∥ P) ∈ ?X ∪ bisim" by(blast intro: resChain.base[THEN sym])
moreover have Res: "⋀x P Q. (P, Q) ∈ ?X ∪ bisim ⟹ (<νx>P, <νx>Q) ∈ ?X ∪ bisim"
by(auto intro: resPres resChain.step[THEN sym])
ultimately have "P ∥ Q ↝[(?X ∪ bisim)] Q ∥ P" by(rule parSym)
moreover have "eqvt ?X" by(force simp add: eqvt_def)
hence "eqvt(?X ∪ bisim)" by auto
ultimately have "resChain lst (P ∥ Q) ↝[(?X ∪ bisim)] resChain lst (Q ∥ P)" using Res
by(rule resChainI)
}
with ‹(PQ, QP) ∈ ?X› show ?case by auto
next
case(cSym PQ QP)
thus ?case by auto
qed
qed
lemma scopeExtPar:
fixes P :: pi
and Q :: pi
and x :: name
assumes "x ♯ P"
shows "<νx>(P ∥ Q) ∼ P ∥ <νx>Q"
proof -
let ?X = "{(resChain lst (<νx>(P ∥ Q)), resChain lst (P ∥ <νx>Q)) | lst x P Q. x ♯ P} ∪
{(resChain lst (P ∥ <νx>Q), resChain lst (<νx>(P ∥ Q))) | lst x P Q. x ♯ P}"
let ?Y = "bisim O (?X ∪ bisim) O bisim"
have Res: "⋀P Q x. (P, Q) ∈ ?X ⟹ (<νx>P, <νx>Q) ∈ ?X" by(blast intro: resChain.step[THEN sym])
from ‹x ♯ P› have "(<νx>(P ∥ Q), P ∥ <νx>Q) ∈ ?X" by(blast intro: resChain.base[THEN sym])
moreover have EqvtX: "eqvt ?X" by(fastforce simp add: eqvt_def name_fresh_left name_rev_per)
ultimately show ?thesis
proof(coinduct rule: bisimTransitiveCoinduct)
case(cSim P Q)
{
fix P Q lst x
assume "(x::name) ♯ (P::pi)"
moreover have "Id ⊆ ?Y" by(blast intro: reflexive)
moreover from ‹eqvt ?X› bisimEqvt have "eqvt ?Y" by blast
moreover have "⋀P Q x. x ♯ P ⟹ (<νx>(P ∥ Q), P ∥ <νx>Q) ∈ ?Y"
by(blast intro: resChain.base[THEN sym] reflexive)
moreover {
fix P Q x y
have "<νx><νy>(P ∥ Q) ∼ <νy><νx>(P ∥ Q)" by(rule resComm)
moreover assume "x ♯ P"
hence "(<νx>(P ∥ Q), P ∥ <νx>Q) ∈ ?X" by(fastforce intro: resChain.base[THEN sym])
hence "(<νy><νx>(P ∥ Q), <νy>(P ∥ <νx>Q)) ∈ ?X" by(rule Res)
ultimately have "(<νx><νy>(P ∥ Q), <νy>(P ∥ <νx>Q)) ∈ ?Y" by(blast intro: reflexive)
}
ultimately have "<νx>(P ∥ Q) ↝[?Y] (P ∥ <νx>Q)" by(rule scopeExtParLeft)
moreover note ‹eqvt ?Y›
moreover from Res have "⋀P Q x. (P, Q) ∈ ?Y ⟹ (<νx>P, <νx>Q) ∈ ?Y"
by(blast intro: resChain.step[THEN sym] dest: resPres)
ultimately have "resChain lst (<νx>(P ∥ Q)) ↝[?Y] resChain lst (P ∥ <νx>Q)"
by(rule resChainI)
}
moreover {
fix P Q lst x
assume "(x::name) ♯ (P::pi)"
moreover have "Id ⊆ ?Y" by(blast intro: reflexive)
moreover from ‹eqvt ?X› bisimEqvt have "eqvt ?Y" by blast
moreover have "⋀P Q x. x ♯ P ⟹ (P ∥ <νx>Q, <νx>(P ∥ Q)) ∈ ?Y"
by(blast intro: resChain.base[THEN sym] reflexive)
moreover {
fix P Q x y
have "<νy><νx>(P ∥ Q) ∼ <νx><νy>(P ∥ Q)" by(rule resComm)
moreover assume "x ♯ P"
hence "(P ∥ <νx>Q, <νx>(P ∥ Q)) ∈ ?X" by(fastforce intro: resChain.base[THEN sym])
hence "(<νy>(P ∥ <νx>Q), <νy><νx>(P ∥ Q)) ∈ ?X" by(rule Res)
ultimately have "(<νy>(P ∥ <νx>Q), <νx><νy>(P ∥ Q)) ∈ ?Y" by(blast intro: reflexive)
}
ultimately have "(P ∥ <νx>Q) ↝[?Y] <νx>(P ∥ Q)"
by(rule scopeExtParRight)
moreover note ‹eqvt ?Y›
moreover from Res have "⋀P Q x. (P, Q) ∈ ?Y ⟹ (<νx>P, <νx>Q) ∈ ?Y"
by(blast intro: resChain.step[THEN sym] dest: resPres)
ultimately have "resChain lst (P ∥ <νx>Q) ↝[?Y] resChain lst (<νx>(P ∥ Q))"
by(rule resChainI)
}
ultimately show ?case using ‹(P, Q) ∈ ?X› by auto
next
case(cSym P Q)
thus ?case
by auto (blast dest: symmetric transitive intro: resChain.base[THEN sym] reflexive)+
qed
qed
lemma scopeExtPar':
fixes P :: pi
and Q :: pi
and x :: name
assumes xFreshQ: "x ♯ Q"
shows "<νx>(P ∥ Q) ∼ (<νx>P) ∥ Q"
proof -
have "<νx>(P ∥ Q) ∼ <νx>(Q ∥ P)"
proof -
have "P ∥ Q ∼ Q ∥ P" by(rule parSym)
thus ?thesis by(rule resPres)
qed
moreover from xFreshQ have "<νx>(Q ∥ P) ∼ Q ∥ (<νx>P)" by(rule scopeExtPar)
moreover have "Q ∥ <νx>P ∼ (<νx>P) ∥ Q" by(rule parSym)
ultimately show ?thesis by(blast intro: transitive)
qed
lemma parAssoc:
fixes P :: pi
and Q :: pi
and R :: pi
shows "(P ∥ Q) ∥ R ∼ P ∥ (Q ∥ R)"
proof -
let ?X = "{(resChain lst ((P ∥ Q) ∥ R), resChain lst (P ∥ (Q ∥ R))) | lst P Q R. True}"
let ?Y = "bisim O (?X ∪ bisim) O bisim"
have ResX: "⋀P Q x. (P, Q) ∈ ?X ⟹ (<νx>P, <νx>Q) ∈ ?X"
by(blast intro: resChain.step[symmetric])
hence ResY: "⋀P Q x. (P, Q) ∈ ?Y ⟹ (<νx>P, <νx>Q) ∈ ?Y"
by(blast intro: resChain.step[symmetric] dest: resPres)
have "((P ∥ Q) ∥ R, P ∥ (Q ∥ R)) ∈ ?X" by(blast intro: resChain.base[symmetric])
moreover have "eqvt ?X" by(fastforce simp add: eqvt_def)
ultimately show ?thesis
proof(coinduct rule: bisimTransitiveCoinduct)
case(cSim P Q)
{
fix P Q R lst
have "⋀P Q R. ((P ∥ Q) ∥ R, P ∥ (Q ∥ R)) ∈ ?Y" by(blast intro: reflexive resChain.base[symmetric])
moreover have "⋀P Q x. (P, Q) ∈ ?Y ⟹ (<νx>P, <νx>Q) ∈ ?Y" by(blast intro: resChain.step[symmetric] resPres)
moreover {
fix P Q R x
have "(<νx>((P ∥ Q) ∥ R), <νx>(P ∥ (Q ∥ R))) ∈ ?X" by(rule_tac ResX) (blast intro: resChain.base[symmetric])
moreover assume "x ♯ P"
hence "<νx>(P ∥ (Q ∥ R)) ∼ P ∥ <νx>(Q ∥ R)" by(rule scopeExtPar)
ultimately have "(<νx>((P ∥ Q) ∥ R), P ∥ <νx>(Q ∥ R)) ∈ ?Y" by(blast intro: reflexive)
}
moreover {
fix P Q R x
have "(<νx>((P ∥ Q) ∥ R), <νx>(P ∥ (Q ∥ R))) ∈ ?X" by(rule_tac ResX) (blast intro: resChain.base[symmetric])
moreover assume "x ♯ R"
hence "<νx>(P ∥ Q) ∥ R ∼ <νx>((P ∥ Q) ∥ R)" by(metis scopeExtPar' symmetric)
ultimately have "(<νx>(P ∥ Q) ∥ R, <νx>(P ∥ (Q ∥ R))) ∈ ?Y" by(blast intro: reflexive)
}
ultimately have "(P ∥ Q) ∥ R ↝[?Y] P ∥ (Q ∥ R)" by(rule parAssocLeft)
moreover from ‹eqvt ?X› bisimEqvt have "eqvt ?Y" by blast
ultimately have "resChain lst ((P ∥ Q) ∥ R) ↝[?Y] resChain lst (P ∥ (Q ∥ R))" using ResY
by(rule resChainI)
}
with ‹(P, Q) ∈ ?X› show ?case by auto
next
case(cSym P Q)
{
fix P Q R lst
have "P ∥ (Q ∥ R) ∼ (R ∥ Q) ∥ P" by(metis parPres parSym transitive)
moreover have "((R ∥ Q) ∥ P, R ∥ (Q ∥ P)) ∈ ?X" by(blast intro: resChain.base[symmetric])
moreover have "R ∥ (Q ∥ P) ∼ (P ∥ Q) ∥ R" by(metis parPres parSym transitive)
ultimately have "(P ∥ (Q ∥ R), (P ∥ Q) ∥ R) ∈ ?Y" by blast
hence "(resChain lst (P ∥ (Q ∥ R)), resChain lst ((P ∥ Q) ∥ R)) ∈ ?Y" using ResY
by(induct lst) auto
}
with ‹(P, Q) ∈ ?X› show ?case by blast
qed
qed
lemma scopeFresh:
fixes x :: name
and P :: pi
assumes "x ♯ P"
shows "<νx>P ∼ P"
proof -
have "<νx>P ∼ <νx>P ∥ 𝟬" by(rule parZero[THEN symmetric])
moreover have "<νx>P ∥ 𝟬 ∼ 𝟬 ∥ <νx>P" by(rule parSym)
moreover have "𝟬 ∥ <νx>P ∼ <νx>(𝟬 ∥ P)" by(rule scopeExtPar[THEN symmetric]) auto
moreover have "<νx>(𝟬 ∥ P) ∼ <νx>(P ∥ 𝟬)" by(rule resPres[OF parSym])
moreover from ‹x ♯ P› have "<νx>(P ∥ 𝟬) ∼ P ∥ <νx>𝟬" by(rule scopeExtPar)
moreover have "P ∥ <νx>𝟬 ∼ <νx>𝟬 ∥ P" by(rule parSym)
moreover have "<νx>𝟬 ∥ P ∼ 𝟬 ∥ P" by(rule parPres[OF nilRes])
moreover have "𝟬 ∥ P ∼ P ∥ 𝟬" by(rule parSym)
moreover have "P ∥ 𝟬 ∼ P" by(rule parZero)
ultimately show ?thesis by(metis transitive)
qed
lemma sumRes:
fixes x :: name
and P :: pi
and Q :: pi
shows "<νx>(P ⊕ Q) ∼ (<νx>P) ⊕ (<νx>Q)"
proof -
let ?X = "{(<νx>(P ⊕ Q), <νx>P ⊕ <νx>Q) | x P Q. True} ∪
{(<νx>P ⊕ <νx>Q, <νx>(P ⊕ Q)) | x P Q. True}"
have "(<νx>(P ⊕ Q), <νx>P ⊕ <νx>Q) ∈ ?X" by auto
moreover have "eqvt ?X" by(fastforce simp add: eqvt_def)
ultimately show ?thesis
by(coinduct rule: bisimCoinduct) (fastforce intro: sumResLeft sumResRight reflexive)+
qed
lemma scopeExtSum:
fixes P :: pi
and Q :: pi
and x :: name
assumes "x ♯ P"
shows "<νx>(P ⊕ Q) ∼ P ⊕ <νx>Q"
proof -
have "<νx>(P ⊕ Q) ∼ <νx>P ⊕ <νx>Q" by(rule sumRes)
moreover from ‹x ♯ P› have "<νx>P ⊕ <νx>Q ∼ P ⊕ <νx>Q"
by(rule sumPres[OF scopeFresh])
ultimately show ?thesis by(rule transitive)
qed
lemma bangSC:
fixes P :: pi
shows "!P ∼ P ∥ !P"
proof -
let ?X = "{(!P, P ∥ !P), (P ∥ !P, !P)}"
have "(!P, P ∥ !P) ∈ ?X" by simp
thus ?thesis
by(coinduct rule: bisimCoinduct) (auto intro: bangLeftSC bangRightSC reflexive)
qed
lemma resNil:
fixes x :: name
and y :: name
and P :: pi
and b :: name
shows "<νx>x<y>.P ∼ 𝟬"
and "<νx>x{b}.P ∼ 𝟬"
proof -
let ?X = "{(<νx>x<y>.P, 𝟬), (𝟬, <νx>x<y>.P)}"
have "(<νx>x<y>.P, 𝟬) ∈ ?X" by simp
thus "<νx>x<y>.P ∼ 𝟬"
by(coinduct rule: bisimCoinduct) (auto simp add: simulation_def)
next
let ?X = "{(<νx>x{b}.P, 𝟬), (𝟬, <νx>x{b}.P)}"
have "(<νx>x{b}.P, 𝟬) ∈ ?X" by simp
thus "<νx>x{b}.P ∼ 𝟬"
by(coinduct rule: bisimCoinduct) (auto simp add: simulation_def)
qed
lemma resInput:
fixes x :: name
and a :: name
and y :: name
and P :: pi
assumes "x ≠ a"
and "x ≠ y"
shows "<νx>a<y>.P ∼ a<y>.(<νx>P)"
proof -
let ?X = "{(<νx>a<y>.P, a<y>.(<νx>P)) | x a y P. x ≠ a ∧ x ≠ y} ∪
{(a<y>.(<νx>P), <νx>a<y>.P) | x a y P. x ≠ a ∧ x ≠ y}"
from assms have "(<νx>a<y>.P, a<y>.(<νx>P)) ∈ ?X" by auto
moreover have "eqvt ?X" by(fastforce simp add: eqvt_def pt_bij[OF pt_name_inst, OF at_name_inst])
ultimately show ?thesis
by(coinduct rule: bisimCoinduct) (fastforce intro: resInputLeft reflexive resInputRight)+
qed
lemma resOutput:
fixes x :: name
and a :: name
and b :: name
and P :: pi
assumes "x ≠ a"
and "x ≠ b"
shows "<νx>a{b}.P ∼ a{b}.(<νx>P)"
proof -
let ?X = "{(<νx>a{b}.P, a{b}.(<νx>P)) | x a b P. x ≠ a ∧ x ≠ b} ∪
{(a{b}.(<νx>P), <νx>a{b}.P) | x a b P. x ≠ a ∧ x ≠ b}"
from assms have "(<νx>a{b}.P, a{b}.(<νx>P)) ∈ ?X" by blast
moreover have "eqvt ?X" by(fastforce simp add: eqvt_def pt_bij[OF pt_name_inst, OF at_name_inst])
ultimately show ?thesis
by(coinduct rule: bisimCoinduct) (fastforce intro: resOutputLeft resOutputRight reflexive)+
qed
lemma resTau:
fixes x :: name
and P :: pi
shows "<νx>τ.(P) ∼ τ.(<νx>P)"
proof -
let ?X = "{(<νx>τ.(P), τ.(<νx>P)), (τ.(<νx>P), <νx>τ.(P))}"
have "(<νx>τ.(P), τ.(<νx>P)) ∈ ?X" by auto
thus ?thesis
by(coinduct rule: bisimCoinduct) (fastforce intro: resTauLeft resTauRight reflexive)+
qed
inductive structCong :: "pi ⇒ pi ⇒ bool" ("_ ≡⇩s _" [70, 70] 70)
where
Refl: "P ≡⇩s P"
| Sym: "P ≡⇩s Q ⟹ Q ≡⇩s P"
| Trans: "⟦P ≡⇩s Q; Q ≡⇩s R⟧ ⟹ P ≡⇩s R"
| SumComm: "P ⊕ Q ≡⇩s Q ⊕ P"
| SumAssoc: "(P ⊕ Q) ⊕ R ≡⇩s P ⊕ (Q ⊕ R)"
| SumId: "P ⊕ 𝟬 ≡⇩s P"
| ParComm: "P ∥ Q ≡⇩s Q ∥ P"
| ParAssoc: "(P ∥ Q) ∥ R ≡⇩s P ∥ (Q ∥ R)"
| ParId: "P ∥ 𝟬 ≡⇩s P"
| MatchId: "[a⌢a]P ≡⇩s P"
| ResNil: "<νx>𝟬 ≡⇩s 𝟬"
| ResComm: "<νx><νy>P ≡⇩s <νy><νx>P"
| ResSum: "<νx>(P ⊕ Q) ≡⇩s <νx>P ⊕ <νx>Q"
| ScopeExtPar: "x ♯ P ⟹ <νx>(P ∥ Q) ≡⇩s P ∥ <νx>Q"
| InputRes: "⟦x ≠ a; x ≠ y⟧ ⟹ <νx>a<y>.P ≡⇩s a<y>.(<νx>P)"
| OutputRes: "⟦x ≠ a; x ≠ b⟧ ⟹ <νx>a{b}.P ≡⇩s a{b}.(<νx>P)"
| TauRes: "<νx>τ.(P) ≡⇩s τ.(<νx>P)"
| BangUnfold: "!P ≡⇩s P ∥ !P"
lemma structCongBisim:
fixes P :: pi
and Q :: pi
assumes "P ≡⇩s Q"
shows "P ∼ Q"
using assms
by(induct rule: structCong.induct)
(auto intro: reflexive symmetric transitive sumSym sumAssoc sumZero parSym parAssoc parZero
nilRes resComm resInput resOutput resTau sumRes scopeExtPar bangSC matchId mismatchId)
end
Theory Strong_Late_Bisim_Subst_SC
theory Strong_Late_Bisim_Subst_SC
imports Strong_Late_Bisim_Subst_Pres Strong_Late_Bisim_SC
begin
lemma matchId:
fixes a :: name
and P :: pi
shows "[a⌢a]P ∼⇧s P"
by(auto simp add: substClosed_def intro: Strong_Late_Bisim_SC.matchId)
lemma mismatchNil:
fixes a :: name
and P :: pi
shows "[a≠a]P ∼⇧s 𝟬"
by(auto simp add: substClosed_def intro: Strong_Late_Bisim_SC.mismatchNil)
lemma scopeFresh:
fixes P :: pi
and x :: name
assumes xFreshP: "x ♯ P"
shows "<νx>P ∼⇧s P"
proof(auto simp add: substClosed_def)
fix s :: "(name × name) list"
have "∃c::name. c ♯ (P, s)" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshP: "c ♯ P" and cFreshs: "c ♯ s" by(force simp add: fresh_prod)
have "<νx>P = <νc>P"
proof -
from cFreshP have "<νx>P = <νc>([(x, c)] ∙ P)" by(simp add: alphaRes)
with cFreshP xFreshP show ?thesis by(simp add: name_fresh_fresh)
qed
with cFreshP cFreshs show "(<νx>P)[<s>] ∼ P[<s>]"
by(force intro: Strong_Late_Bisim_SC.scopeFresh)
qed
lemma resComm:
fixes P :: pi
and x :: name
and y :: name
shows "<νx><νy>P ∼⇧s <νy><νx>P"
proof(cases "x=y")
assume xeqy: "x=y"
have "P ∼⇧s P" by(rule Strong_Late_Bisim_Subst.reflexive)
hence "<νx>P ∼⇧s <νx>P" by(rule resPres)
hence "<νx><νx>P ∼⇧s <νx><νx>P" by(rule resPres)
with xeqy show ?thesis by simp
next
assume xineqy: "x ≠ y"
show ?thesis
proof(auto simp add: substClosed_def)
fix s::"(name × name) list"
have "∃c::name. c ♯ (P, s, y)" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshP: "c ♯ P" and cFreshs: "c ♯ s" and cineqy: "c ≠ y"
by(force simp add: fresh_prod)
have "∃d::name. d ♯ (P, s, c, x, y)" by (blast intro: name_exists_fresh)
then obtain d::name where dFreshP: "d ♯ P" and dFreshs: "d ♯ s" and dineqc: "d ≠ c"
and dineqx: "d ≠ x" and dineqy: "d ≠ y"
by(force simp add: fresh_prod)
have "<νx><νy>P = <νc><νd>([(x, c)] ∙ [(y, d)] ∙ P)"
proof -
from cineqy cFreshP have cFreshyP: "c ♯ <νy>P" by(simp add: name_fresh_abs)
from dFreshP have "<νy>P = <νd>([(y, d)] ∙ P)" by(rule alphaRes)
moreover from cFreshyP have "<νx><νy>P = <νc>([(x, c)] ∙ (<νy>P))" by(rule alphaRes)
ultimately show ?thesis using dineqc dineqx by(simp add: name_calc)
qed
moreover have "<νy><νx>P = <νd><νc>([(x, c)] ∙ [(y, d)] ∙ P)"
proof -
from dineqx dFreshP have dFreshxP: "d ♯ <νx>P" by(simp add: name_fresh_abs)
from cFreshP have "<νx>P = <νc>([(x, c)] ∙ P)" by(rule alphaRes)
moreover from dFreshxP have "<νy><νx>P = <νd>([(y, d)] ∙ (<νx>P))" by(rule alphaRes)
ultimately have "<νy><νx>P = <νd><νc>([(y, d)] ∙ [(x, c)] ∙ P)" using dineqc cineqy
by(simp add: name_calc)
thus ?thesis using dineqx dineqc cineqy xineqy
by(subst name_perm_compose, simp add: name_calc)
qed
ultimately show "(<νx><νy>P)[<s>] ∼ (<νy><νx>P)[<s>]" using cFreshs dFreshs
by(force intro: Strong_Late_Bisim_SC.resComm)
qed
qed
lemma sumZero:
fixes P :: pi
shows "P ⊕ 𝟬 ∼⇧s P"
by(force simp add: substClosed_def intro: Strong_Late_Bisim_SC.sumZero)
lemma sumSym:
fixes P :: pi
and Q :: pi
shows "P ⊕ Q ∼⇧s Q ⊕ P"
by(force simp add: substClosed_def intro: Strong_Late_Bisim_SC.sumSym)
lemma sumAssoc:
fixes P :: pi
and Q :: pi
and R :: pi
shows "(P ⊕ Q) ⊕ R ∼⇧s P ⊕ (Q ⊕ R)"
by(force simp add: substClosed_def intro: Strong_Late_Bisim_SC.sumAssoc)
lemma sumRes:
fixes P :: pi
and Q :: pi
and x :: name
shows "<νx>(P ⊕ Q) ∼⇧s <νx>P ⊕ <νx>Q"
proof(auto simp add: substClosed_def)
fix s :: "(name × name) list"
have "∃c::name. c ♯ (P, Q, s)" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshP: "c ♯ P" and cFreshQ: "c ♯ Q" and cFreshs: "c ♯ s"
by(force simp add: fresh_prod)
have "<νx>(P ⊕ Q) = <νc>(([(x, c)] ∙ P) ⊕ ([(x, c)] ∙ Q))"
proof -
from cFreshP cFreshQ have "c ♯ P ⊕ Q" by simp
hence "<νx>(P ⊕ Q) = <νc>([(x, c)] ∙ (P ⊕ Q))" by(simp add: alphaRes)
thus ?thesis by(simp add: name_fresh_fresh)
qed
moreover from cFreshP have "<νx>P = <νc>([(x, c)] ∙ P)" by(simp add: alphaRes)
moreover from cFreshQ have "<νx>Q = <νc>([(x, c)] ∙ Q)" by(simp add: alphaRes)
ultimately show "(<νx>(P ⊕ Q))[<s>] ∼ (<νx>P)[<s>] ⊕ (<νx>Q)[<s>]" using cFreshs
by(force intro: Strong_Late_Bisim_SC.sumRes)
qed
lemma scopeExtSum:
fixes P :: pi
and Q :: pi
and x :: name
assumes xFreshP: "x ♯ P"
shows "<νx>(P ⊕ Q) ∼⇧s P ⊕ <νx>Q"
proof(auto simp add: substClosed_def)
fix s :: "(name × name) list"
have "∃c::name. c ♯ (P, Q, s)" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshP: "c ♯ P" and cFreshQ: "c ♯ Q" and cFreshs: "c ♯ s"
by(force simp add: fresh_prod)
have "<νx>(P ⊕ Q) = <νc>(P ⊕ ([(x, c)] ∙ Q))"
proof -
from cFreshP cFreshQ have "c ♯ P ⊕ Q" by simp
hence "<νx>(P ⊕ Q) = <νc>([(x, c)] ∙ (P ⊕ Q))" by(simp add: alphaRes)
with xFreshP cFreshP show ?thesis by(simp add: name_fresh_fresh)
qed
moreover from cFreshQ have "<νx>Q = <νc>([(x, c)] ∙ Q)" by(simp add: alphaRes)
ultimately show "(<νx>(P ⊕ Q))[<s>] ∼ P[<s>] ⊕ (<νx>Q)[<s>]" using cFreshs cFreshP
by(force intro: Strong_Late_Bisim_SC.scopeExtSum)
qed
lemma parZero:
fixes P :: pi
shows "P ∥ 𝟬 ∼⇧s P"
by(force simp add: substClosed_def intro: Strong_Late_Bisim_SC.parZero)
lemma parSym:
fixes P :: pi
and Q :: pi
shows "P ∥ Q ∼⇧s Q ∥ P"
by(force simp add: substClosed_def intro: Strong_Late_Bisim_SC.parSym)
lemma parAssoc:
fixes P :: pi
and Q :: pi
and R :: pi
shows "(P ∥ Q) ∥ R ∼⇧s P ∥ (Q ∥ R)"
by(force simp add: substClosed_def intro: Strong_Late_Bisim_SC.parAssoc)
lemma scopeExtPar:
fixes P :: pi
and Q :: pi
and x :: name
assumes xFreshP: "x ♯ P"
shows "<νx>(P ∥ Q) ∼⇧s P ∥ <νx>Q"
proof(auto simp add: substClosed_def)
fix s :: "(name × name) list"
have "∃c::name. c ♯ (P, Q, s)" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshP: "c ♯ P" and cFreshQ: "c ♯ Q" and cFreshs: "c ♯ s"
by(force simp add: fresh_prod)
have "<νx>(P ∥ Q) = <νc>(P ∥ ([(x, c)] ∙ Q))"
proof -
from cFreshP cFreshQ have "c ♯ P ∥ Q" by simp
hence "<νx>(P ∥ Q) = <νc>([(x, c)] ∙ (P ∥ Q))" by(simp add: alphaRes)
with xFreshP cFreshP show ?thesis by(simp add: name_fresh_fresh)
qed
moreover from cFreshQ have "<νx>Q = <νc>([(x, c)] ∙ Q)" by(simp add: alphaRes)
ultimately show "(<νx>(P ∥ Q))[<s>] ∼ P[<s>] ∥ (<νx>Q)[<s>]" using cFreshs cFreshP
by(force intro: Strong_Late_Bisim_SC.scopeExtPar)
qed
lemma scopeExtPar':
fixes P :: pi
and Q :: pi
and x :: name
assumes xFreshP: "x ♯ Q"
shows "<νx>(P ∥ Q) ∼⇧s (<νx>P) ∥ Q"
proof -
have "<νx>(P ∥ Q) ∼⇧s <νx>(Q ∥ P)" by(blast intro: parSym resPres)
moreover from xFreshP have "<νx>(Q ∥ P) ∼⇧s Q ∥ <νx>P" by(rule scopeExtPar)
moreover have "Q ∥ <νx>P ∼⇧s (<νx>P) ∥ Q" by(rule parSym)
ultimately show ?thesis by (blast intro: transitive)
qed
lemma bangSC:
fixes P :: pi
shows "!P ∼⇧s P ∥ !P"
by(auto simp add: substClosed_def intro: Strong_Late_Bisim_SC.bangSC)
lemma nilRes:
fixes x :: name
shows "<νx>𝟬 ∼⇧s 𝟬"
proof(auto simp add: substClosed_def)
fix σ::"(name × name) list"
obtain y::name where "y ♯ σ"
by(generate_fresh "name") auto
have "<νy>𝟬 ∼ 𝟬" by (rule Strong_Late_Bisim_SC.nilRes)
with ‹y ♯ σ› have "(<νy>𝟬)[<σ>] ∼ 𝟬" by simp
thus "(<νx>𝟬)[<σ>] ∼ 𝟬"
by(subst alphaRes[where c=y]) auto
qed
lemma resTau:
fixes x :: name
and P :: pi
shows "<νx>(τ.(P)) ∼⇧s τ.(<νx>P)"
proof(auto simp add: substClosed_def)
fix σ::"(name × name) list"
obtain y::name where "y ♯ P" and "y ♯ σ"
by(generate_fresh "name", auto)
have "<νy>(τ.(([(x, y)] ∙ P)[<σ>])) ∼ τ.(<νy>(([(x, y)] ∙ P)[<σ>]))"
by(rule resTau)
with ‹y ♯ σ› have "(<νy>(τ.([(x, y)] ∙ P)))[<σ>] ∼ (τ.(<νy>([(x, y)] ∙ P)))[<σ>]"
by simp
with ‹y ♯ P› show "(<νx>τ.(P))[<σ>] ∼ τ.((<νx>P)[<σ>])"
apply(subst alphaRes[where c=y])
apply simp
apply(subst alphaRes[where c=y and a=x])
by simp+
qed
lemma resOutput:
fixes x :: name
and a :: name
and b :: name
and P :: pi
assumes "x ≠ a"
and "x ≠ b"
shows "<νx>(a{b}.(P)) ∼⇧s a{b}.(<νx>P)"
proof(auto simp add: substClosed_def)
fix σ::"(name × name) list"
obtain y::name where "y ♯ P" and "y ♯ σ" and "y ≠ a" and "y ≠ b"
by(generate_fresh "name", auto)
have "<νy>((seq_subst_name a σ){seq_subst_name b σ}.(([(x, y)] ∙ P)[<σ>])) ∼ seq_subst_name a σ{seq_subst_name b σ}.(<νy>(([(x, y)] ∙ P)[<σ>]))"
using ‹y ≠ a› ‹y ≠ b› ‹y ♯ σ› freshSeqSubstName
by(rule_tac resOutput) auto
with ‹y ♯ σ› have "(<νy>(a{b}.([(x, y)] ∙ P)))[<σ>] ∼ (a{b}.(<νy>([(x, y)] ∙ P)))[<σ>]"
by simp
with ‹y ♯ P› ‹y ≠ a› ‹y ≠ b› ‹x ≠ a› ‹x ≠ b› show "(<νx>a{b}.(P))[<σ>] ∼ seq_subst_name a σ{seq_subst_name b σ}.((<νx>P)[<σ>])"
apply(subst alphaRes[where c=y])
apply simp
apply(subst alphaRes[where c=y and a=x])
by simp+
qed
lemma resInput:
fixes x :: name
and a :: name
and b :: name
and P :: pi
assumes "x ≠ a"
and "x ≠ y"
shows "<νx>(a<y>.(P)) ∼⇧s a<y>.(<νx>P)"
proof(auto simp add: substClosed_def)
fix σ::"(name × name) list"
obtain x'::name where "x' ♯ P" and "x' ♯ σ" and "x' ≠ a" and "x' ≠ x" and "x' ≠ y"
by(generate_fresh "name", auto)
obtain y'::name where "y' ♯ P" and "y' ♯ σ" and "y' ≠ a" and "y' ≠ x" and "y' ≠ y" and "x' ≠ y'"
by(generate_fresh "name", auto)
have "<νx'>((seq_subst_name a σ)<y'>.(([(y, y')] ∙ [(x, x')] ∙ P)[<σ>])) ∼ seq_subst_name a σ<y'>.(<νx'>(([(y, y')] ∙ [(x, x')] ∙ P)[<σ>]))"
using ‹x' ≠ a› ‹x' ≠ y'› ‹x' ♯ σ› ‹y' ♯ σ› freshSeqSubstName
by(rule_tac resInput) auto
with ‹x' ♯ σ› ‹y' ♯ σ› have "(<νx'>(a<y'>.([(y, y')] ∙ [(x, x')] ∙ P)))[<σ>] ∼ (a<y'>.(<νx'>([(y, y')] ∙ [(x, x')] ∙ P)))[<σ>]"
by simp
with ‹x' ♯ P› ‹y' ≠ x› ‹x' ≠ y› ‹y' ♯ P› ‹x' ≠ y'› ‹x' ≠ a› ‹y' ≠ a› ‹x ≠ a› ‹x ≠ y› show "(<νx>a<y>.(P))[<σ>] ∼ a<y>.(<νx>P)[<σ>]"
apply(subst alphaInput[where c=y'])
apply simp
apply(subst alphaRes[where c=x'])
apply(simp add: abs_fresh fresh_left calc_atm)
apply(simp add: eqvts calc_atm)
apply(subst alphaRes[where c=x' and a=x])
apply simp
apply(subst alphaInput[where c=y' and x=y])
apply(simp add: abs_fresh fresh_left calc_atm)
apply(simp add: eqvts calc_atm)
apply(subst perm_compose)
by(simp add: eqvts calc_atm)
qed
lemma bisimSubstStructCong:
fixes P :: pi
and Q :: pi
assumes "P ≡⇩s Q"
shows "P ∼⇧s Q"
using assms
apply(induct rule: structCong.induct)
by(auto intro: reflexive symmetric transitive sumSym sumAssoc sumZero parSym parAssoc parZero
nilRes resComm resInput resOutput resTau sumRes scopeExtPar bangSC matchId mismatchId)
end
Theory Weak_Late_Cong_Subst_SC
theory Weak_Late_Cong_Subst_SC
imports Weak_Late_Cong_Subst Strong_Late_Bisim_Subst_SC
begin
lemma resComm:
fixes P :: pi
shows "<νa><νb>P ≃⇧s <νb><νa>P"
proof -
have "<νa><νb>P ∼⇧s <νb><νa>P"
by(rule Strong_Late_Bisim_Subst_SC.resComm)
thus ?thesis by(rule strongEqWeakCong)
qed
lemma matchId:
fixes a :: name
and P :: pi
shows "[a⌢a]P ≃⇧s P"
proof -
have "[a⌢a]P ∼⇧s P" by(rule Strong_Late_Bisim_Subst_SC.matchId)
thus ?thesis by(rule strongEqWeakCong)
qed
lemma matchNil:
fixes a :: name
and P :: pi
shows "[a≠a]P ≃⇧s 𝟬"
proof -
have "[a≠a]P ∼⇧s 𝟬" by(rule Strong_Late_Bisim_Subst_SC.mismatchNil)
thus ?thesis by(rule strongEqWeakCong)
qed
lemma sumSym:
fixes P :: pi
and Q :: pi
shows "P ⊕ Q ≃⇧s Q ⊕ P"
proof -
have "P ⊕ Q ∼⇧s Q ⊕ P" by(rule Strong_Late_Bisim_Subst_SC.sumSym)
thus ?thesis by(rule strongEqWeakCong)
qed
lemma sumAssoc:
fixes P :: pi
and Q :: pi
and R :: pi
shows "(P ⊕ Q) ⊕ R ≃⇧s P ⊕ (Q ⊕ R)"
proof -
have "(P ⊕ Q) ⊕ R ∼⇧s P ⊕ (Q ⊕ R)" by(rule Strong_Late_Bisim_Subst_SC.sumAssoc)
thus ?thesis by(rule strongEqWeakCong)
qed
lemma sumZero:
fixes P :: pi
shows "P ⊕ 𝟬 ≃⇧s P"
proof -
have "P ⊕ 𝟬 ∼⇧s P" by(rule Strong_Late_Bisim_Subst_SC.sumZero)
thus ?thesis by(rule strongEqWeakCong)
qed
lemma parZero:
fixes P :: pi
shows "P ∥ 𝟬 ≃⇧s P"
proof -
have "P ∥ 𝟬 ∼⇧s P" by(rule Strong_Late_Bisim_Subst_SC.parZero)
thus ?thesis by(rule strongEqWeakCong)
qed
lemma parSym:
fixes P :: pi
and Q :: pi
shows "P ∥ Q ≃⇧s Q ∥ P"
proof -
have "P ∥ Q ∼⇧s Q ∥ P" by(rule Strong_Late_Bisim_Subst_SC.parSym)
thus ?thesis by(rule strongEqWeakCong)
qed
lemma scopeExtPar:
fixes P :: pi
and Q :: pi
and x :: name
assumes "x ♯ P"
shows "<νx>(P ∥ Q) ≃⇧s P ∥ <νx>Q"
proof -
from assms have "<νx>(P ∥ Q) ∼⇧s P ∥ <νx>Q" by(rule Strong_Late_Bisim_Subst_SC.scopeExtPar)
thus ?thesis by(rule strongEqWeakCong)
qed
lemma scopeExtPar':
fixes P :: pi
and Q :: pi
and x :: name
assumes xFreshQ: "x ♯ Q"
shows "<νx>(P ∥ Q) ≃⇧s (<νx>P) ∥ Q"
proof -
from assms have "<νx>(P ∥ Q) ∼⇧s (<νx>P) ∥ Q" by(rule Strong_Late_Bisim_Subst_SC.scopeExtPar')
thus ?thesis by(rule strongEqWeakCong)
qed
lemma parAssoc:
fixes P :: pi
and Q :: pi
and R :: pi
shows "(P ∥ Q) ∥ R ≃⇧s P ∥ (Q ∥ R)"
proof -
have "(P ∥ Q) ∥ R ∼⇧s P ∥ (Q ∥ R)" by(rule Strong_Late_Bisim_Subst_SC.parAssoc)
thus ?thesis by(rule strongEqWeakCong)
qed
lemma scopeFresh:
fixes P :: pi
and a :: name
assumes aFreshP: "a ♯ P"
shows "<νa>P ≃⇧s P"
proof -
from assms have "<νa>P ∼⇧s P" by(rule Strong_Late_Bisim_Subst_SC.scopeFresh)
thus ?thesis by(rule strongEqWeakCong)
qed
lemma scopeExtSum:
fixes P :: pi
and Q :: pi
and x :: name
assumes "x ♯ P"
shows "<νx>(P ⊕ Q) ≃⇧s P ⊕ <νx>Q"
proof -
from assms have "<νx>(P ⊕ Q) ∼⇧s P ⊕ <νx>Q" by(rule Strong_Late_Bisim_Subst_SC.scopeExtSum)
thus ?thesis by(rule strongEqWeakCong)
qed
lemma bangSC:
fixes P
shows "!P ≃⇧s P ∥ !P"
proof -
have "!P ∼⇧s P ∥ !P" by(rule Strong_Late_Bisim_Subst_SC.bangSC)
thus ?thesis by(rule strongEqWeakCong)
qed
end
Theory Weak_Late_Step_Sim_Pres
theory Weak_Late_Step_Sim_Pres
imports Weak_Late_Step_Sim
begin
lemma tauPres:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes PRelQ: "(P, Q) ∈ Rel"
shows "τ.(P) ↝<Rel> τ.(Q)"
proof(induct rule: simCases)
case(Bound Q' a y)
have "τ.(Q) ⟼a<νy> ≺ Q'" by fact
hence False by auto
thus ?case by simp
next
case(Input Q' a x)
have "τ.(Q) ⟼a<x> ≺ Q'" by fact
hence False by auto
thus ?case by simp
next
case(Free Q' α)
have "τ.(Q) ⟼ α ≺ Q'" by fact
thus ?case using PRelQ
proof(induct rule: tauCases, auto simp add: pi.inject residual.inject)
have "τ.(P) ⟹⇩lτ ≺ P" by(rule Weak_Late_Step_Semantics.Tau)
moreover assume "(P, Q') ∈ Rel"
ultimately show "∃P'. τ.(P) ⟹⇩lτ ≺ P' ∧ (P', Q') ∈ Rel" by blast
qed
qed
lemma inputPres:
fixes P :: pi
and Q :: pi
and a :: name
and x :: name
and Rel :: "(pi × pi) set"
assumes PRelQ: "∀y. (P[x::=y], Q[x::=y]) ∈ Rel"
and Eqvt: "eqvt Rel"
shows "a<x>.P ↝<Rel> a<x>.Q"
proof -
show ?thesis using Eqvt
proof(induct rule: simCasesCont[of _ "(P, a, x, Q)"])
case(Bound Q' b y)
have "a<x>.Q ⟼b<νy> ≺ Q'" by fact
hence False by auto
thus ?case by simp
next
case(Input Q' b y)
have "y ♯ (P, a, x, Q)" by fact
hence yFreshP: "(y::name) ♯ P" and yineqx: "y ≠ x" and "y ≠ a" and "y ♯ Q"
by(simp add: fresh_prod)+
have "a<x>.Q ⟼b<y> ≺ Q'" by fact
thus ?case using ‹y ≠ a› ‹y ≠ x› ‹y ♯ Q›
proof(induct rule: inputCases, auto simp add: subject.inject)
have "∀u. ∃P'. a<x>.P ⟹⇩lu in ([(x, y)] ∙ P)→a<y> ≺ P' ∧ (P', ([(x, y)] ∙ Q)[y::=u]) ∈ Rel"
proof(rule allI)
fix u
have "a<x>.P ⟹⇩lu in ([(x, y)] ∙ P)→a<y> ≺ ([(x, y)] ∙ P)[y::=u]" (is "?goal")
proof -
from yFreshP have "a<x>.P = a<y>.([(x, y)] ∙ P)" by(rule Agent.alphaInput)
moreover have "a<y>.([(x, y)] ∙ P) ⟹⇩lu in ([(x, y)] ∙ P)→a<y> ≺ ([(x, y)] ∙ P)[y::=u]"
by(rule Weak_Late_Step_Semantics.Input)
ultimately show ?goal by(simp add: name_swap)
qed
moreover have "(([(x, y)] ∙ P)[y::=u], ([(x, y)] ∙ Q)[y::=u]) ∈ Rel"
proof -
from PRelQ have "(P[x::=u], Q[x::=u]) ∈ Rel" by auto
with ‹y ♯ P› ‹y ♯ Q› show ?thesis by(simp add: renaming)
qed
ultimately show "∃P'. a<x>.P ⟹⇩lu in ([(x, y)] ∙ P)→a<y> ≺ P' ∧ (P', ([(x, y)] ∙ Q)[y::=u]) ∈ Rel"
by blast
qed
thus "∃P''. ∀u. ∃P'. a<x>.P ⟹⇩lu in P''→a<y> ≺ P' ∧ (P', ([(x, y)] ∙ Q)[y::=u]) ∈ Rel" by blast
qed
next
case(Free Q' α)
have "a<x>.Q ⟼α ≺ Q'" by fact
hence False by auto
thus ?case by simp
qed
qed
lemma outputPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes PRelQ: "(P, Q) ∈ Rel"
shows "a{b}.P ↝<Rel> a{b}.Q"
proof(induct rule: simCases)
case(Bound Q' c x)
have "a{b}.Q ⟼c<νx> ≺ Q'" by fact
hence False by auto
thus ?case by simp
next
case(Input Q' c x)
have "a{b}.Q ⟼c<x> ≺ Q'" by fact
hence False by auto
thus ?case by simp
next
case(Free Q' α)
have "a{b}.Q ⟼α ≺ Q'" by fact
thus ?case using PRelQ
proof(induct rule: outputCases, auto simp add: pi.inject residual.inject)
have "a{b}.P ⟹⇩la[b] ≺ P" by(rule Weak_Late_Step_Semantics.Output)
moreover assume "(P, Q') ∈ Rel"
ultimately show "∃P'. a{b}.P ⟹⇩la[b] ≺ P' ∧ (P', Q') ∈ Rel" by blast
qed
qed
lemma matchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes PSimQ: "P ↝<Rel> Q"
and RelRel': "Rel ⊆ Rel'"
shows "[a⌢b]P ↝<Rel'> [a⌢b]Q"
proof(induct rule: simCases)
case(Bound Q' c x)
have "x ♯ [a⌢b]P" by fact
hence xFreshP: "(x::name) ♯ P" by simp
have "[a⌢b]Q ⟼ c<νx> ≺ Q'" by fact
thus ?case
proof(induct rule: matchCases)
case cMatch
have "Q ⟼c<νx> ≺ Q'" by fact
with PSimQ xFreshP obtain P' where PTrans: "P ⟹⇩lc<νx> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans have "[a⌢a]P ⟹⇩lc<νx> ≺ P'" by(rule Weak_Late_Step_Semantics.Match)
moreover from P'RelQ' RelRel' have "(P', Q') ∈ Rel'" by blast
ultimately show ?case by blast
qed
next
case(Input Q' c x)
have "x ♯ [a⌢b]P" by fact
hence xFreshP: "(x::name) ♯ P" by simp
have "[a⌢b]Q ⟼c<x> ≺ Q'" by fact
thus ?case
proof(induct rule: matchCases)
case cMatch
have "Q ⟼ c<x> ≺ Q'" by fact
with PSimQ xFreshP obtain P'' where L1: "∀u. ∃P'. P ⟹⇩lu in P''→c<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel"
by(blast dest: simE)
have "∀u. ∃P'. [a⌢a]P ⟹⇩lu in P''→c<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel'"
proof(rule allI)
fix u
from L1 obtain P' where PTrans: "P ⟹⇩lu in P''→c<x> ≺ P'" and P'RelQ': "(P', Q'[x::=u]) ∈ Rel"
by blast
from PTrans have "[a⌢a]P ⟹⇩lu in P''→c<x> ≺ P'" by(rule Weak_Late_Step_Semantics.Match)
with P'RelQ' RelRel' show "∃P'. [a⌢a]P ⟹⇩lu in P''→c<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel'"
by blast
qed
thus ?case by blast
qed
next
case(Free Q' α)
have "[a⌢b]Q ⟼α ≺ Q'" by fact
thus ?case
proof(induct rule: matchCases)
case cMatch
have "Q ⟼α ≺ Q'" by fact
with PSimQ obtain P' where PTrans: "P ⟹⇩lα ≺ P'" and PRel: "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans have "[a⌢a]P ⟹⇩lα ≺ P'" by(rule Weak_Late_Step_Semantics.Match)
with PRel RelRel' show ?case by blast
qed
qed
lemma mismatchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes PSimQ: "P ↝<Rel> Q"
and RelRel': "Rel ⊆ Rel'"
shows "[a≠b]P ↝<Rel'> [a≠b]Q"
proof(cases "a=b")
assume "a=b"
thus ?thesis
by(auto simp add: weakStepSimDef)
next
assume aineqb: "a≠b"
show ?thesis
proof(induct rule: simCases)
case(Bound Q' c x)
have "x ♯ [a≠b]P" by fact
hence xFreshP: "(x::name) ♯ P" by simp
have "[a≠b]Q ⟼ c<νx> ≺ Q'" by fact
thus ?case
proof(induct rule: mismatchCases)
case cMismatch
have "Q ⟼c<νx> ≺ Q'" by fact
with PSimQ xFreshP obtain P' where PTrans: "P ⟹⇩lc<νx> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans aineqb have "[a≠b]P ⟹⇩lc<νx> ≺ P'" by(rule Weak_Late_Step_Semantics.Mismatch)
moreover from P'RelQ' RelRel' have "(P', Q') ∈ Rel'" by blast
ultimately show ?case by blast
qed
next
case(Input Q' c x)
have "x ♯ [a≠b]P" by fact
hence xFreshP: "(x::name) ♯ P" by simp
have "[a≠b]Q ⟼c<x> ≺ Q'" by fact
thus ?case
proof(induct rule: mismatchCases)
case cMismatch
have "Q ⟼ c<x> ≺ Q'" by fact
with PSimQ xFreshP obtain P'' where L1: "∀u. ∃P'. P ⟹⇩lu in P''→c<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel"
by(blast dest: simE)
have "∀u. ∃P'. [a≠b]P ⟹⇩lu in P''→c<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel'"
proof(rule allI)
fix u
from L1 obtain P' where PTrans: "P ⟹⇩lu in P''→c<x> ≺ P'" and P'RelQ': "(P', Q'[x::=u]) ∈ Rel"
by blast
from PTrans aineqb have "[a≠b]P ⟹⇩lu in P''→c<x> ≺ P'" by(rule Weak_Late_Step_Semantics.Mismatch)
with P'RelQ' RelRel' show "∃P'. [a≠b]P ⟹⇩lu in P''→c<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel'"
by blast
qed
thus ?case by blast
qed
next
case(Free Q' α)
have "[a≠b]Q ⟼α ≺ Q'" by fact
thus ?case
proof(induct rule: mismatchCases)
case cMismatch
have "Q ⟼α ≺ Q'" by fact
with PSimQ obtain P' where PTrans: "P ⟹⇩lα ≺ P'" and PRel: "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans ‹a ≠ b› have "[a≠b]P ⟹⇩lα ≺ P'" by(rule Weak_Late_Step_Semantics.Mismatch)
with PRel RelRel' show ?case by blast
qed
qed
qed
lemma sumCompose:
fixes P :: pi
and Q :: pi
and R :: pi
and T :: pi
assumes PSimQ: "P ↝<Rel> Q"
and RSimT: "R ↝<Rel> T"
and RelRel': "Rel ⊆ Rel'"
shows "P ⊕ R ↝<Rel'> Q ⊕ T"
proof(induct rule: simCases)
case(Bound Q' a x)
have "x ♯ P ⊕ R" by fact
hence xFreshP: "(x::name) ♯ P" and xFreshR: "x ♯ R" by simp+
have "Q ⊕ T ⟼a<νx> ≺ Q'" by fact
thus ?case
proof(induct rule: sumCases)
case cSum1
have "Q ⟼a<νx> ≺ Q'" by fact
with xFreshP PSimQ obtain P' where PTrans: "P ⟹⇩la<νx> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans have "P ⊕ R ⟹⇩la<νx> ≺ P'" by(rule Weak_Late_Step_Semantics.Sum1)
moreover from P'RelQ' RelRel' have "(P', Q') ∈ Rel'" by blast
ultimately show ?case by blast
next
case cSum2
have "T ⟼a<νx> ≺ Q'" by fact
with xFreshR RSimT obtain R' where RTrans: "R ⟹⇩la<νx> ≺ R'" and R'RelQ': "(R', Q') ∈ Rel"
by(blast dest: simE)
from RTrans have "P ⊕ R ⟹⇩la<νx> ≺ R'" by(rule Weak_Late_Step_Semantics.Sum2)
moreover from R'RelQ' RelRel' have "(R', Q') ∈ Rel'" by blast
ultimately show ?thesis by blast
qed
next
case(Input Q' a x)
have "x ♯ P ⊕ R" by fact
hence xFreshP: "(x::name) ♯ P" and xFreshR: "x ♯ R" by simp+
have "Q ⊕ T ⟼a<x> ≺ Q'" by fact
thus ?case
proof(induct rule: sumCases)
case cSum1
have "Q ⟼a<x> ≺ Q'" by fact
with xFreshP PSimQ obtain P'' where L1: "∀u. ∃P'. P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel"
by(blast dest: simE)
have "∀u. ∃P'. P ⊕ R ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel'"
proof(rule allI)
fix u
from L1 obtain P' where PTrans: "P ⟹⇩lu in P''→a<x> ≺ P'"
and P'RelQ': "(P', Q'[x::=u]) ∈ Rel" by blast
from PTrans have "P ⊕ R ⟹⇩lu in P''→a<x> ≺ P'" by(rule Weak_Late_Step_Semantics.Sum1)
with P'RelQ' RelRel' show "∃P'. P ⊕ R ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel'" by blast
qed
thus ?case by blast
next
case cSum2
have "T ⟼a<x> ≺ Q'" by fact
with xFreshR RSimT obtain R'' where L1: "∀u. ∃R'. R ⟹⇩lu in R''→a<x> ≺ R' ∧ (R', Q'[x::=u]) ∈ Rel"
by(blast dest: simE)
have "∀u. ∃P'. P ⊕ R ⟹⇩lu in R''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel'"
proof(rule allI)
fix u
from L1 obtain R' where RTrans: "R ⟹⇩lu in R''→a<x> ≺ R'"
and R'RelQ': "(R', Q'[x::=u]) ∈ Rel" by blast
from RTrans have "P ⊕ R ⟹⇩lu in R''→a<x> ≺ R'" by(rule Weak_Late_Step_Semantics.Sum2)
with R'RelQ' RelRel' show "∃P'. P ⊕ R ⟹⇩lu in R''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel'" by blast
qed
thus ?case by blast
qed
next
case(Free Q' α)
have "Q ⊕ T ⟼α ≺ Q'" by fact
thus ?case
proof(induct rule: sumCases)
case cSum1
have "Q ⟼α ≺ Q'" by fact
with PSimQ obtain P' where PTrans: "P ⟹⇩lα ≺ P'" and PRel: "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans have "P ⊕ R ⟹⇩lα ≺ P'" by(rule Weak_Late_Step_Semantics.Sum1)
with RelRel' PRel show ?case by blast
next
case cSum2
have "T ⟼α ≺ Q'" by fact
with RSimT obtain R' where RTrans: "R ⟹⇩lα ≺ R'" and RRel: "(R', Q') ∈ Rel"
by(blast dest: simE)
from RTrans have "P ⊕ R ⟹⇩lα ≺ R'" by(rule Weak_Late_Step_Semantics.Sum2)
with RelRel' RRel show ?case by blast
qed
qed
lemma sumPres:
fixes P :: pi
and Q :: pi
and R :: pi
assumes PSimQ: "P ↝<Rel> Q"
and Id: "Id ⊆ Rel"
and RelRel': "Rel ⊆ Rel'"
shows "P ⊕ R ↝<Rel'> Q ⊕ R"
proof -
from Id have Refl: "R ↝<Rel> R" by(rule reflexive)
from PSimQ Refl RelRel' show ?thesis by(rule sumCompose)
qed
lemma parPres:
fixes P :: pi
and Q :: pi
and R :: pi
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes PSimQ: "P ↝<Rel> Q"
and PRelQ: "(P, Q) ∈ Rel"
and Par: "⋀P Q R. (P, Q) ∈ Rel ⟹ (P ∥ R, Q ∥ R) ∈ Rel'"
and Res: "⋀P Q a. (P, Q) ∈ Rel' ⟹ (<νa>P, <νa>Q) ∈ Rel'"
and EqvtRel: "eqvt Rel"
and EqvtRel': "eqvt Rel'"
shows "P ∥ R ↝<Rel'> Q ∥ R"
using EqvtRel'
proof(induct rule: simCasesCont[where C="(P, Q, R)"])
case(Bound Q' a x)
have "x ♯ (P, Q, R)" by fact
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" and "x ♯ Q" by simp+
from ‹Q ∥ R ⟼ a<νx> ≺ Q'› ‹x ♯ Q› ‹x ♯ R› show ?case
proof(induct rule: parCasesB)
case(cPar1 Q')
have QTrans: "Q ⟼ a<νx> ≺ Q'" by fact
from xFreshP PSimQ QTrans obtain P' where PTrans:"P ⟹⇩l a<νx> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans xFreshR have "P ∥ R ⟹⇩l a<νx> ≺ (P' ∥ R)" by(rule Weak_Late_Step_Semantics.Par1B)
moreover from P'RelQ' have "(P' ∥ R, Q' ∥ R) ∈ Rel'" by(rule Par)
ultimately show ?case by blast
next
case(cPar2 R')
have RTrans: "R ⟼ a<νx> ≺ R'" by fact
hence "R ⟹⇩l a<νx> ≺ R'"
by(auto simp add: weakTransition_def dest: Weak_Late_Step_Semantics.singleActionChain)
with xFreshP xFreshR have ParTrans: "P ∥ R ⟹⇩la<νx> ≺ P ∥ R'"
by(blast intro: Weak_Late_Step_Semantics.Par2B)
moreover from PRelQ have "(P ∥ R', Q ∥ R') ∈ Rel'" by(rule Par)
ultimately show ?case by blast
qed
next
case(Input Q' a x)
have "x ♯ (P, Q, R)" by fact
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" and "x ♯ Q" by simp+
from ‹Q ∥ R ⟼a<x> ≺ Q'› ‹x ♯ Q› ‹x ♯ R›
show ?case
proof(induct rule: parCasesB)
case(cPar1 Q')
have QTrans: "Q ⟼a<x> ≺ Q'" by fact
from xFreshP PSimQ QTrans obtain P''
where L1: "∀u. ∃P'. P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel"
by(blast dest: simE)
have "∀u. ∃P'. P ∥ R ⟹⇩lu in (P'' ∥ R)→a<x> ≺ P' ∧ (P', Q'[x::=u] ∥ R[x::=u]) ∈ Rel'"
proof(rule allI)
fix u
from L1 obtain P' where PTrans:"P ⟹⇩lu in P''→a<x> ≺ P'"
and P'RelQ': "(P', Q'[x::=u]) ∈ Rel" by blast
from PTrans xFreshR have "P ∥ R ⟹⇩lu in (P'' ∥ R)→a<x> ≺ (P' ∥ R)"
by(rule Weak_Late_Step_Semantics.Par1B)
moreover from P'RelQ' have "(P' ∥ R, Q'[x::=u] ∥ R) ∈ Rel'"
by(rule Par)
ultimately show "∃P'. P ∥ R ⟹⇩lu in (P'' ∥ R)→a<x> ≺ P' ∧ (P', Q'[x::=u] ∥ (R[x::=u])) ∈ Rel'"
using xFreshR
by(force simp add: forget)
qed
thus ?case by force
next
case(cPar2 R')
have RTrans: "R ⟼a<x> ≺ R'" by fact
have "∀u. ∃P'. P ∥ R ⟹⇩lu in (P ∥ R')→a<x> ≺ P' ∧ (P', Q ∥ R'[x::=u]) ∈ Rel'"
proof
fix u
from RTrans have "R ⟹⇩lu in R'→a<x> ≺ R'[x::=u]"
by(rule Weak_Late_Step_Semantics.singleActionChain)
hence "P ∥ R ⟹⇩lu in P ∥ R'→a<x> ≺ P ∥ R'[x::=u]" using ‹x ♯ P›
by(rule Weak_Late_Step_Semantics.Par2B)
moreover from PRelQ have "(P ∥ R'[x::=u], Q ∥ R'[x::=u]) ∈ Rel'" by(rule Par)
ultimately show "∃P'. P ∥ R ⟹⇩lu in (P ∥ R')→a<x> ≺ P' ∧
(P', Q ∥ R'[x::=u]) ∈ Rel'" by blast
qed
thus ?case using ‹x ♯ Q› by(fastforce simp add: forget)
qed
next
case(Free QR' α)
have "Q ∥ R ⟼ α ≺ QR'" by fact
thus ?case
proof(induct rule: parCasesF[of _ _ _ _ _ "(P, R)"])
case(cPar1 Q')
have "Q ⟼ α ≺ Q'" by fact
with PSimQ obtain P' where PTrans: "P ⟹⇩lα ≺ P'" and PRel: "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans have Trans: "P ∥ R ⟹⇩lα ≺ P' ∥ R" by(rule Weak_Late_Step_Semantics.Par1F)
moreover from PRel have "(P' ∥ R, Q' ∥ R) ∈ Rel'" by(blast intro: Par)
ultimately show ?case by blast
next
case(cPar2 R')
have "R ⟼ α ≺ R'" by fact
hence "R ⟹⇩lα ≺ R'"
by(rule Weak_Late_Step_Semantics.singleActionChain)
hence "P ∥ R ⟹⇩lα ≺ (P ∥ R')" by(rule Weak_Late_Step_Semantics.Par2F)
moreover from PRelQ have "(P ∥ R', Q ∥ R') ∈ Rel'" by(blast intro: Par)
ultimately show ?case by blast
next
case(cComm1 Q' R' a b x)
have QTrans: "Q ⟼ a<x> ≺ Q'" and RTrans: "R ⟼ a[b] ≺ R'" by fact+
have "x ♯ (P, R)" by fact
hence xFreshP: "x ♯ P" by(simp add: fresh_prod)
from PSimQ QTrans xFreshP obtain P' P'' where PTrans: "P ⟹⇩lb in P''→a<x> ≺ P'"
and P'RelQ': "(P', Q'[x::=b]) ∈ Rel"
by(blast dest: simE)
from RTrans have "R ⟹⇩la[b] ≺ R'"
by(rule Weak_Late_Step_Semantics.singleActionChain)
with PTrans have "P ∥ R ⟹⇩lτ ≺ P' ∥ R'" by(rule Weak_Late_Step_Semantics.Comm1)
moreover from P'RelQ' have "(P' ∥ R', Q'[x::=b] ∥ R') ∈ Rel'" by(rule Par)
ultimately show ?case by blast
next
case(cComm2 Q' R' a b x)
have QTrans: "Q ⟼a[b] ≺ Q'" and RTrans: "R ⟼a<x> ≺ R'" by fact+
have "x ♯ (P, R)" by fact
hence xFreshR: "x ♯ R" by(simp add: fresh_prod)
from PSimQ QTrans obtain P' where PTrans: "P ⟹⇩la[b] ≺ P'"
and PRel: "(P', Q') ∈ Rel"
by(blast dest: simE)
from RTrans have "R ⟹⇩lb in R'→a<x> ≺ R'[x::=b]"
by(rule Weak_Late_Step_Semantics.singleActionChain)
with PTrans have "P ∥ R ⟹⇩lτ ≺ P' ∥ R'[x::=b]" by(rule Weak_Late_Step_Semantics.Comm2)
moreover from PRel have "(P' ∥ R'[x::=b], Q' ∥ R'[x::=b]) ∈ Rel'" by(rule Par)
ultimately show ?case by blast
next
case(cClose1 Q' R' a x y)
have QTrans: "Q ⟼a<x> ≺ Q'" and RTrans: "R ⟼a<νy> ≺ R'" by fact+
have "x ♯ (P, R)" and "y ♯ (P, R)" by fact+
hence xFreshP: "x ♯ P" and yFreshR: "y ♯ R" and yFreshP: "y ♯ P" by(simp add: fresh_prod)+
from PSimQ QTrans xFreshP obtain P' P'' where PTrans: "P ⟹⇩ly in P''→a<x> ≺ P'"
and P'RelQ': "(P', Q'[x::=y]) ∈ Rel"
by(blast dest: simE)
from RTrans have "R ⟹⇩la<νy> ≺ R'"
by(auto simp add: weakTransition_def dest: Weak_Late_Step_Semantics.singleActionChain)
with PTrans have Trans: "P ∥ R ⟹⇩lτ ≺ <νy>(P' ∥ R')" using yFreshP yFreshR
by(rule Weak_Late_Step_Semantics.Close1)
moreover from P'RelQ' have "(<νy>(P' ∥ R'), <νy>(Q'[x::=y] ∥ R')) ∈ Rel'"
by(blast intro: Par Res)
ultimately show ?case by blast
next
case(cClose2 Q' R' a x y)
have QTrans: "Q ⟼a<νy> ≺ Q'" and RTrans: "R ⟼a<x> ≺ R'" by fact+
have "x ♯ (P, R)" and "y ♯ (P, R)" by fact+
hence xFreshR: "x ♯ R" and yFreshP: "y ♯ P" and yFreshR: "y ♯ R" by(simp add: fresh_prod)+
from PSimQ QTrans yFreshP obtain P' where PTrans: "P ⟹⇩la<νy> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from RTrans have "R ⟹⇩ly in R'→a<x> ≺ R'[x::=y]"
by(rule Weak_Late_Step_Semantics.singleActionChain)
with PTrans have "P ∥ R ⟹⇩lτ ≺ <νy>(P' ∥ R'[x::=y])" using yFreshP yFreshR
by(rule Weak_Late_Step_Semantics.Close2)
moreover from P'RelQ' have "(<νy>(P' ∥ R'[x::=y]), <νy>(Q' ∥ R'[x::=y])) ∈ Rel'"
by(blast intro: Par Res)
ultimately show ?case by blast
qed
qed
lemma resPres:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and x :: name
and Rel' :: "(pi × pi) set"
assumes PSimQ: "P ↝<Rel> Q"
and ResRel: "⋀(P::pi) (Q::pi) (x::name). (P, Q) ∈ Rel ⟹ (<νx>P, <νx>Q) ∈ Rel'"
and RelRel': "Rel ⊆ Rel'"
and EqvtRel: "eqvt Rel"
and EqvtRel': "eqvt Rel'"
shows "<νx>P ↝<Rel'> <νx>Q"
proof -
from EqvtRel' show ?thesis
proof(induct rule: simCasesCont[of _ "(P, Q, x)"])
case(Bound Q' a y)
have Trans: "<νx>Q ⟼a<νy> ≺ Q'" by fact
have "y ♯ (P, Q, x)" by fact
hence yineqx: "y ≠ x" and yFreshP: "y ♯ P" and "y ♯ Q" by(simp add: fresh_prod)+
from Trans ‹y ≠ x› ‹y ♯ Q› show ?case
proof(induct rule: resCasesB)
case(cOpen a Q')
have QTrans: "Q ⟼a[x] ≺ Q'" and aineqx: "a ≠ x" by fact+
from PSimQ QTrans obtain P' where PTrans: "P ⟹⇩la[x] ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
have "<νx>P ⟹⇩la<νy> ≺ ([(y, x)] ∙ P')"
proof -
from PTrans aineqx have "<νx>P ⟹⇩la<νx> ≺ P'" by(rule Weak_Late_Step_Semantics.Open)
moreover from PTrans yFreshP have "y ♯ P'" by(force intro: Weak_Late_Step_Semantics.freshTransition)
ultimately show ?thesis by(simp add: alphaBoundResidual name_swap)
qed
moreover from EqvtRel P'RelQ' RelRel' have "([(y, x)] ∙ P', [(y, x)] ∙ Q') ∈ Rel'"
by(blast intro: eqvtRelI)
ultimately show ?case by blast
next
case(cRes Q')
have QTrans: "Q ⟼a<νy> ≺ Q'" by fact
from ‹x ♯ BoundOutputS a› have "x ≠ a" by simp
from PSimQ yFreshP QTrans obtain P' where PTrans: "P ⟹⇩la<νy> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans ‹x ≠ a› yineqx yFreshP have ResTrans: "<νx>P ⟹⇩la<νy> ≺ (<νx>P')"
by(blast intro: Weak_Late_Step_Semantics.ResB)
moreover from P'RelQ' have "((<νx>P'), (<νx>Q')) ∈ Rel'"
by(rule ResRel)
ultimately show ?case by blast
qed
next
case(Input Q' a y)
have "y ♯ (P, Q, x)" by fact
hence yineqx: "y ≠ x" and yFreshP: "y ♯ P" and "y ♯ Q" by(simp add: fresh_prod)+
have "<νx>Q ⟼a<y> ≺ Q'" by fact
thus ?case using yineqx ‹y ♯ Q›
proof(induct rule: resCasesB)
case(cOpen a Q')
thus ?case by simp
next
case(cRes Q')
have QTrans: "Q ⟼a<y> ≺ Q'" by fact
from ‹x ♯ InputS a› have "x ≠ a" by simp
from PSimQ QTrans yFreshP obtain P''
where L1: "∀u. ∃P'. P ⟹⇩lu in P''→a<y> ≺ P' ∧ (P', Q'[y::=u]) ∈ Rel"
by(blast dest: simE)
have "∀u. ∃P'. <νx>P ⟹⇩lu in (<νx>P'')→a<y> ≺ P' ∧ (P', (<νx>Q')[y::=u]) ∈ Rel'"
proof(rule allI)
fix u
show "∃P'. <νx>P ⟹⇩lu in <νx>P''→a<y> ≺ P' ∧ (P', (<νx>Q')[y::=u]) ∈ Rel'"
proof(cases "x=u")
assume xequ: "x=u"
have "∃c::name. c ♯ (P, P'', Q', x, y, a)" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshP: "c ♯ P" and cFreshP'': "c ♯ P''" and cFreshQ': "c ♯ Q'"
and cineqx: "c ≠ x" and cineqy: "c ≠ y" and cineqa: "c ≠ a"
by(force simp add: fresh_prod)
from L1 obtain P' where PTrans: "P ⟹⇩lc in P''→a<y> ≺ P'"
and P'RelQ': "(P', Q'[y::=c]) ∈ Rel"
by blast
have "<νx>P ⟹⇩lu in (<νx>P'')→a<y> ≺ <νc>([(x, c)] ∙ P')"
proof -
from PTrans yineqx ‹x ≠ a› cineqx have "<νx>P ⟹⇩lc in (<νx>P'')→a<y> ≺ <νx>P'"
by(blast intro: Weak_Late_Step_Semantics.ResB)
hence "([(x, c)] ∙ <νx>P) ⟹⇩l([(x, c)] ∙ c) in ([(x, c)] ∙ <νx>P'')→([(x, c)] ∙ a)<([(x, c)] ∙ y)> ≺ [(x, c)] ∙ <νx>P'"
by(rule Weak_Late_Step_Semantics.eqvtI)
moreover from cFreshP have "<νc>([(x, c)] ∙ P) = <νx>P" by(simp add: alphaRes)
moreover from cFreshP'' have "<νc>([(x, c)] ∙ P'') = <νx>P''" by(simp add: alphaRes)
ultimately show ?thesis using ‹x ≠ a› cineqa yineqx cineqy cineqx xequ by(simp add: name_calc)
qed
moreover have "(<νc>([(x, c)] ∙ P'), (<νx>Q')[y::=u]) ∈ Rel'"
proof -
from P'RelQ' have "(<νx>P', <νx>(Q'[y::=c])) ∈ Rel'" by(rule ResRel)
with EqvtRel' have "([(x, c)] ∙ <νx>P', [(x, c)] ∙ <νx>(Q'[y::=c])) ∈ Rel'" by(rule eqvtRelI)
with cineqy yineqx cineqx have "(<νc>([(x, c)] ∙ P'), (<νc>([(x, c)] ∙ Q'))[y::=x]) ∈ Rel'"
by(simp add: name_calc eqvt_subs)
with cFreshQ' xequ show ?thesis by(simp add: alphaRes)
qed
ultimately show ?thesis by blast
next
assume xinequ: "x ≠ u"
from L1 obtain P' where PTrans: "P ⟹⇩lu in P''→a<y> ≺ P'"
and P'RelQ': "(P', Q'[y::=u]) ∈ Rel" by blast
from PTrans ‹x ≠ a› yineqx xinequ have "<νx>P ⟹⇩lu in (<νx>P'')→a<y> ≺ <νx>P'"
by(blast intro: Weak_Late_Step_Semantics.ResB)
moreover from P'RelQ' xinequ yineqx have "(<νx>P', (<νx>Q')[y::=u]) ∈ Rel'"
by(force intro: ResRel)
ultimately show ?thesis by blast
qed
qed
thus ?case by blast
qed
next
case(Free Q' α)
have "<νx>Q ⟼ α ≺ Q'" by fact
thus ?case
proof(induct rule: resCasesF)
case(cRes Q')
have "Q ⟼α ≺ Q'" by fact
with PSimQ obtain P' where PTrans: "P ⟹⇩lα ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
have "<νx>P ⟹⇩lα ≺ <νx>P'"
proof -
have xFreshAlpha: "x ♯ α" by fact
with PTrans show ?thesis by(rule Weak_Late_Step_Semantics.ResF)
qed
moreover from P'RelQ' have "(<νx>P', <νx>Q') ∈ Rel'" by(rule ResRel)
ultimately show ?case by blast
qed
qed
qed
lemma bangPres:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
assumes PSimQ: "P ↝<Rel'> Q"
and PRelQ: "(P, Q) ∈ Rel"
and Sim: "⋀P Q. (P, Q) ∈ Rel ⟹ P ↝<Rel'> Q"
and RelRel': "⋀P Q. (P, Q) ∈ Rel ⟹ (P, Q) ∈ Rel'"
and eqvtRel': "eqvt Rel'"
shows "!P ↝<bangRel Rel'> !Q"
proof -
from eqvtRel' have EqvtBangRel': "eqvt(bangRel Rel')" by(rule eqvtBangRel)
from RelRel' have BRelRel': "⋀P Q. (P, Q) ∈ bangRel Rel ⟹ (P, Q) ∈ bangRel Rel'"
by(auto intro: bangRelSubset)
have "⋀Rs P. ⟦!Q ⟼ Rs; (P, !Q) ∈ bangRel Rel⟧ ⟹ weakStepSimAct P Rs P (bangRel Rel')"
proof -
fix Rs P
assume "!Q ⟼ Rs" and "(P, !Q) ∈ bangRel Rel"
thus "weakStepSimAct P Rs P (bangRel Rel')"
proof(nominal_induct avoiding: P rule: bangInduct)
case(cPar1B aa x Q' P)
have QTrans: "Q ⟼aa«x» ≺ Q'" and xFreshQ: "x ♯ Q" by fact+
have "(P, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ P" by fact+
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact+
have "x ♯ P ∥ R" by fact
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by simp+
from PRelQ have PSimQ: "P ↝<Rel'> Q" by(rule Sim)
from EqvtBangRel' show ?case
proof(induct rule: simActBoundCases)
case(Input a)
have "aa = InputS a" by fact
with PSimQ QTrans xFreshP obtain P''
where L1: "∀u. ∃P'. P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel'"
by(blast dest: simE)
have "∀u. ∃P'. P ∥ R ⟹⇩lu in (P'' ∥ R)→a<x> ≺ P' ∧ (P', (Q' ∥ !Q)[x::=u]) ∈ bangRel Rel'"
proof(rule allI)
fix u
from L1 obtain P' where PTrans: "P ⟹⇩lu in P''→a<x> ≺ P'"
and P'RelQ': "(P', Q'[x::=u]) ∈ Rel'"
by blast
from PTrans xFreshR have "P ∥ R ⟹⇩lu in (P'' ∥ R)→a<x>≺ P' ∥ R"
by(rule Weak_Late_Step_Semantics.Par1B)
moreover have "(P' ∥ R, (Q' ∥ !Q)[x::=u]) ∈ bangRel Rel'"
proof -
from P'RelQ' RBangRelQ have "(P' ∥ R, Q'[x::=u] ∥ !Q) ∈ bangRel Rel'"
by(blast intro: BRelRel' Rel.BRPar)
with xFreshQ show ?thesis by(force simp add: forget)
qed
ultimately show "∃P'. P ∥ R ⟹⇩lu in (P'' ∥ R)→a<x> ≺ P' ∧
(P', (Q' ∥ !Q)[x::=u]) ∈ bangRel Rel'"
by blast
qed
thus ?case by blast
next
case(BoundOutput a)
have "aa = BoundOutputS a" by fact
with PSimQ QTrans xFreshP obtain P' where PTrans: "P ⟹⇩la<νx> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel'"
by(force dest: simE)
from PTrans xFreshR have "P ∥ R ⟹⇩la<νx>≺ P' ∥ R"
by(rule Weak_Late_Step_Semantics.Par1B)
moreover from P'RelQ' RBangRelQ have "(P' ∥ R, Q' ∥ !Q) ∈ bangRel Rel'"
by(blast intro: Rel.BRPar BRelRel')
ultimately show ?case by blast
qed
qed
next
case(cPar1F α Q' P)
have QTrans: "Q ⟼ α ≺ Q'" by fact
have "(P, Q ∥ !Q) ∈ bangRel Rel" by fact
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact+
show ?case
proof(induct rule: simActFreeCases)
case Free
from PRelQ have "P ↝<Rel'> Q" by(rule Sim)
with QTrans obtain P' where PTrans: "P ⟹⇩lα ≺ P'" and P'RelQ': "(P', Q') ∈ Rel'"
by(blast dest: simE)
from PTrans have "P ∥ R ⟹⇩lα ≺ P' ∥ R" by(rule Weak_Late_Step_Semantics.Par1F)
moreover from P'RelQ' RBangRelQ have "(P' ∥ R, Q' ∥ !Q) ∈ bangRel Rel'"
by(blast intro: BRelRel' Rel.BRPar)
ultimately show ?case by blast
qed
qed
next
case(cPar2B aa x Q' P)
have IH: "⋀P. (P, !Q) ∈ bangRel Rel ⟹ weakStepSimAct P (aa«x» ≺ Q') P (bangRel Rel')" by fact
have xFreshQ: "x ♯ Q" by fact
have "(P, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ P" by fact+
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact+
have "x ♯ P ∥ R" by fact
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by simp+
from RBangRelQ have IH: "weakStepSimAct R (aa«x» ≺ Q') R (bangRel Rel')" by(rule IH)
from EqvtBangRel' show ?case
proof(induct rule: simActBoundCases)
case(Input a)
have "aa = InputS a" by fact
with xFreshR IH obtain R'' where L1: "∀u. ∃R'. R ⟹⇩lu in R''→a<x> ≺ R' ∧
(R', Q'[x::=u]) ∈ bangRel Rel'"
by(simp add: weakStepSimAct_def, blast)
have "∀u. ∃P'. P ∥ R ⟹⇩lu in (P ∥ R'')→a<x> ≺ P' ∧ (P', (Q ∥ Q')[x::=u]) ∈ bangRel Rel'"
proof(rule allI)
fix u
from L1 obtain R' where RTrans: "R ⟹⇩lu in R''→a<x> ≺ R'"
and R'BangRelT': "(R', Q'[x::=u]) ∈ bangRel Rel'"
by blast
from RTrans xFreshP have "P ∥ R ⟹⇩lu in (P ∥ R'')→a<x> ≺ P ∥ R'"
by(rule Weak_Late_Step_Semantics.Par2B)
moreover have "(P ∥ R', (Q ∥ Q')[x::=u]) ∈ bangRel Rel'"
proof -
from PRelQ R'BangRelT' have "(P ∥ R', Q ∥ Q'[x::=u]) ∈ bangRel Rel'"
by(blast intro: RelRel' Rel.BRPar)
with xFreshQ show ?thesis by(simp add: forget)
qed
ultimately show "∃P'. P ∥ R ⟹⇩lu in (P ∥ R'')→a<x> ≺ P' ∧ (P', (Q ∥ Q')[x::=u]) ∈ bangRel Rel'"
by blast
qed
thus ?case by blast
next
case(BoundOutput a)
have "aa = BoundOutputS a" by fact
with IH xFreshR obtain R' where RTrans: "R ⟹⇩la<νx> ≺ R'"
and R'BangRelT': "(R', Q') ∈ bangRel Rel'"
by(simp add: weakStepSimAct_def, blast)
from RTrans xFreshP have "P ∥ R ⟹⇩la<νx> ≺ P ∥ R'"
by(auto intro: Weak_Late_Step_Semantics.Par2B)
moreover from PRelQ R'BangRelT' have "(P ∥ R', Q ∥ Q') ∈ bangRel Rel'"
by(blast intro: RelRel' Rel.BRPar)
ultimately show ?case by blast
qed
qed
next
case(cPar2F α Q')
have IH: "⋀P. (P, !Q) ∈ bangRel Rel ⟹ weakStepSimAct P (α ≺ Q') P (bangRel Rel')" by fact+
have "(P, Q ∥ !Q) ∈ bangRel Rel" by fact
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact+
show ?case
proof(induct rule: simActFreeCases)
case Free
from RBangRelQ have "weakStepSimAct R (α ≺ Q') R (bangRel Rel')" by(rule IH)
then obtain R' where RTrans: "R ⟹⇩lα ≺ R'" and R'BangRelQ': "(R', Q') ∈ bangRel Rel'"
by(simp add: weakStepSimAct_def, blast)
from RTrans have "P ∥ R ⟹⇩lα ≺ P ∥ R'" by(rule Weak_Late_Step_Semantics.Par2F)
moreover from PRelQ R'BangRelQ' have "(P ∥ R', Q ∥ Q') ∈ bangRel Rel'"
by(blast intro: RelRel' Rel.BRPar)
ultimately show ?case by blast
qed
qed
next
case(cComm1 a x Q' b Q'' P)
have QTrans: "Q ⟼ a<x> ≺ Q'" by fact
have IH: "⋀P. (P, !Q) ∈ bangRel Rel ⟹ weakStepSimAct P (a[b] ≺ Q'') P (bangRel Rel')" by fact+
have "(P, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ P" by fact+
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact+
have "x ♯ P ∥ R" by fact
hence xFreshP: "x ♯ P" by simp
show ?case
proof(induct rule: simActFreeCases)
case Free
from PRelQ have "P ↝<Rel'> Q" by(rule Sim)
with QTrans xFreshP obtain P' P'' where PTrans: "P ⟹⇩lb in P''→a<x> ≺ P'"
and P'RelQ': "(P', Q'[x::=b]) ∈ Rel'"
by(blast dest: simE)
from RBangRelQ have "weakStepSimAct R (a[b] ≺ Q'') R (bangRel Rel')" by(rule IH)
then obtain R' where RTrans: "R ⟹⇩la[b] ≺ R'"
and R'RelT': "(R', Q'') ∈ bangRel Rel'"
by(simp add: weakStepSimAct_def, blast)
from PTrans RTrans have "P ∥ R ⟹⇩lτ ≺ (P' ∥ R')"
by(rule Weak_Late_Step_Semantics.Comm1)
moreover from P'RelQ' R'RelT' have "(P' ∥ R', Q'[x::=b] ∥ Q'') ∈ bangRel Rel'"
by(blast intro: RelRel' Rel.BRPar)
ultimately show ?case by blast
qed
qed
next
case(cComm2 a b Q' x Q'' P)
have QTrans: "Q ⟼a[b] ≺ Q'" by fact
have IH: "⋀P. (P, !Q) ∈ bangRel Rel ⟹ weakStepSimAct P (a<x> ≺ Q'') P (bangRel Rel')"
by fact
have "(P, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ P" by fact+
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact+
have "x ♯ P ∥ R" by fact
hence xFreshR: "x ♯ R" by simp
show ?case
proof(induct rule: simActFreeCases)
case Free
from PRelQ have "P ↝<Rel'> Q" by(rule Sim)
with QTrans obtain P' where PTrans: "P ⟹⇩la[b] ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel'"
by(blast dest: simE)
from RBangRelQ have "weakStepSimAct R (a<x> ≺ Q'') R (bangRel Rel')"
by(rule IH)
with xFreshR obtain R' R'' where RTrans: "R ⟹⇩lb in R''→a<x> ≺ R'"
and R'BangRelQ'': "(R', Q''[x::=b]) ∈ bangRel Rel'"
by(simp add: weakStepSimAct_def, blast)
from PTrans RTrans have "P ∥ R ⟹⇩lτ ≺ (P' ∥ R')"
by(rule Weak_Late_Step_Semantics.Comm2)
moreover from P'RelQ' R'BangRelQ'' have "(P' ∥ R', Q' ∥ Q''[x::=b]) ∈ bangRel Rel'"
by(rule Rel.BRPar)
ultimately show ?case by blast
qed
qed
next
case(cClose1 a x Q' y Q'' P)
have QTrans: "Q ⟼ a<x> ≺ Q'" by fact
have IH: "⋀P. (P, !Q) ∈ bangRel Rel ⟹ weakStepSimAct P (a<νy> ≺ Q'') P (bangRel Rel')"
by fact
have "(P, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ P" and "y ♯ P" by fact+
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact+
have "x ♯ P ∥ R" and "y ♯ P ∥ R" by fact+
hence xFreshP: "x ♯ P" and yFreshR: "y ♯ R" and yFreshP: "y ♯ P" by simp+
show ?case
proof(induct rule: simActFreeCases)
case Free
from PRelQ have "P ↝<Rel'> Q" by(rule Sim)
with QTrans xFreshP obtain P' P'' where PTrans: "P ⟹⇩ly in P''→a<x> ≺ P'"
and P'RelQ': "(P', Q'[x::=y]) ∈ Rel'"
by(blast dest: simE)
from RBangRelQ have "weakStepSimAct R (a<νy> ≺ Q'') R (bangRel Rel')" by(rule IH)
with yFreshR obtain R' where RTrans: "R ⟹⇩la<νy> ≺ R'"
and R'BangRelQ'': "(R', Q'') ∈ bangRel Rel'"
by(simp add: weakStepSimAct_def, blast)
from PTrans RTrans yFreshP yFreshR have "P ∥ R ⟹⇩lτ ≺ <νy>(P' ∥ R')"
by(rule Weak_Late_Step_Semantics.Close1)
moreover from P'RelQ' R'BangRelQ'' have "(<νy>(P' ∥ R'), <νy>(Q'[x::=y] ∥ Q'')) ∈ bangRel Rel'"
by(force intro: Rel.BRPar Rel.BRRes)
ultimately show ?case by blast
qed
qed
next
case(cClose2 a y Q' x Q'')
have QTrans: "Q ⟼ a<νy> ≺ Q'" by fact
have IH: "⋀P. (P, !Q) ∈ bangRel Rel ⟹ weakStepSimAct P (a<x> ≺ Q'') P (bangRel Rel')"
by fact
have "(P, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ P" and "y ♯ P" by fact+
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact+
have "x ♯ P ∥ R" and "y ♯ P ∥ R" by fact+
hence xFreshR: "x ♯ R" and yFreshR: "y ♯ R" and yFreshP: "y ♯ P" by simp+
show ?case
proof(induct rule: simActFreeCases)
case Free
from PRelQ have "P ↝<Rel'> Q" by(rule Sim)
with QTrans yFreshP obtain P' where PTrans: "P ⟹⇩la<νy> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel'"
by(blast dest: simE)
from RBangRelQ have "weakStepSimAct R (a<x> ≺ Q'') R (bangRel Rel')"
by(rule IH)
with xFreshR obtain R' R'' where RTrans: "R ⟹⇩ly in R''→a<x> ≺ R'"
and R'BangRelT': "(R', Q''[x::=y]) ∈ bangRel Rel'"
by(simp add: weakStepSimAct_def, blast)
from PTrans RTrans yFreshP yFreshR have "P ∥ R ⟹⇩lτ ≺ <νy>(P' ∥ R')"
by(rule Weak_Late_Step_Semantics.Close2)
moreover from P'RelQ' R'BangRelT' have "(<νy>(P' ∥ R'), <νy>(Q' ∥ Q''[x::=y])) ∈ bangRel Rel'"
by(force intro: Rel.BRPar Rel.BRRes)
ultimately show ?case by blast
qed
qed
next
case(cBang Rs)
have IH: "⋀P. (P, Q ∥ !Q) ∈ bangRel Rel ⟹ weakStepSimAct P Rs P (bangRel Rel')"
by fact
have "(P, !Q) ∈ bangRel Rel" by fact
thus ?case
proof(induct rule: BRBangCases)
case(BRBang P)
have PRelQ: "(P, Q) ∈ Rel" by fact
hence "(!P, !Q) ∈ bangRel Rel" by(rule Rel.BRBang)
with PRelQ have "(P ∥ !P, Q ∥ !Q) ∈ bangRel Rel" by(rule Rel.BRPar)
hence "weakStepSimAct (P ∥ !P) Rs (P ∥ !P) (bangRel Rel')" by(rule IH)
thus ?case
proof(simp (no_asm) add: weakStepSimAct_def, auto)
fix Q' a x
assume "weakStepSimAct (P ∥ !P) (a<νx> ≺ Q') (P ∥ !P) (bangRel Rel')" and "x ♯ P"
then obtain P' where PTrans: "(P ∥ !P) ⟹⇩la<νx> ≺ P'"
and P'RelQ': "(P', Q') ∈ (bangRel Rel')"
by(simp add: weakStepSimAct_def, blast)
from PTrans have "!P ⟹⇩la<νx> ≺ P'"
by(rule Weak_Late_Step_Semantics.Bang)
with P'RelQ' show "∃P'. !P ⟹⇩la<νx> ≺ P' ∧ (P', Q') ∈ bangRel Rel'" by blast
next
fix Q' a x
assume "weakStepSimAct (P ∥ !P) (a<x> ≺ Q') (P ∥ !P) (bangRel Rel')" and "x ♯ P"
then obtain P'' where L1: "∀u. ∃P'. P ∥ !P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ (bangRel Rel')"
by(simp add: weakStepSimAct_def, blast)
have "∀u. ∃P'. !P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ (bangRel Rel')"
proof(rule allI)
fix u
from L1 obtain P' where PTrans: "P ∥ !P ⟹⇩lu in P''→a<x> ≺ P'"
and P'RelQ': "(P', Q'[x::=u]) ∈ (bangRel Rel')"
by blast
from PTrans have "!P ⟹⇩lu in P''→a<x> ≺ P'" by(rule Weak_Late_Step_Semantics.Bang)
with P'RelQ' show "∃P'. !P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ (bangRel Rel')" by blast
qed
thus "∃P''. ∀u. ∃P'. !P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ (bangRel Rel')" by blast
next
fix Q' α
assume "weakStepSimAct (P ∥ !P) (α ≺ Q') (P ∥ !P) (bangRel Rel')"
then obtain P' where PTrans: "(P ∥ !P) ⟹⇩lα ≺ P'"
and P'RelQ': "(P', Q') ∈ (bangRel Rel')"
by(simp add: weakStepSimAct_def, blast)
from PTrans have "!P ⟹⇩lα ≺ P'"
by(rule Weak_Late_Step_Semantics.Bang)
with P'RelQ' show "∃P'. !P ⟹⇩lα ≺ P' ∧ (P', Q') ∈ (bangRel Rel')" by blast
qed
qed
qed
qed
moreover from PRelQ have "(!P, !Q) ∈ bangRel Rel" by(rule Rel.BRBang)
ultimately show ?thesis by(simp add: weakStepSim_def)
qed
end
Theory Weak_Late_Bisim_SC
theory Weak_Late_Bisim_SC
imports Weak_Late_Bisim Strong_Late_Bisim_SC
begin
lemma resComm:
fixes P :: pi
shows "<νa><νb>P ≈ <νb><νa>P"
proof -
have "<νa><νb>P ∼ <νb><νa>P" by(rule Strong_Late_Bisim_SC.resComm)
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma matchId:
fixes a :: name
and P :: pi
shows "[a⌢a]P ≈ P"
proof -
have "[a⌢a]P ∼ P" by(rule Strong_Late_Bisim_SC.matchId)
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma mismatchId:
fixes a :: name
and b :: name
and P :: pi
assumes "a ≠ b"
shows "[a≠b]P ≈ P"
proof -
from assms have "[a≠b]P ∼ P" by(rule Strong_Late_Bisim_SC.mismatchId)
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma mismatchZero:
fixes a :: name
and P :: pi
shows "[a≠a]P ≈ 𝟬"
proof -
have "[a≠a]P ∼ 𝟬" by(rule Strong_Late_Bisim_SC.mismatchNil)
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma sumSym:
fixes P :: pi
and Q :: pi
shows "P ⊕ Q ≈ Q ⊕ P"
proof -
have "P ⊕ Q ∼ Q ⊕ P" by(rule Strong_Late_Bisim_SC.sumSym)
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma sumAssoc:
fixes P :: pi
and Q :: pi
and R :: pi
shows "(P ⊕ Q) ⊕ R ≈ P ⊕ (Q ⊕ R)"
proof -
have "(P ⊕ Q) ⊕ R ∼ P ⊕ (Q ⊕ R)" by(rule Strong_Late_Bisim_SC.sumAssoc)
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma sumZero:
fixes P :: pi
shows "P ⊕ 𝟬 ≈ P"
proof -
have "P ⊕ 𝟬 ∼ P" by(rule Strong_Late_Bisim_SC.sumZero)
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma parZero:
fixes P :: pi
shows "P ∥ 𝟬 ≈ P"
proof -
have "P ∥ 𝟬 ∼ P" by(rule Strong_Late_Bisim_SC.parZero)
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma parSym:
fixes P :: pi
and Q :: pi
shows "P ∥ Q ≈ Q ∥ P"
proof -
have "P ∥ Q ∼ Q ∥ P" by(rule Strong_Late_Bisim_SC.parSym)
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma scopeExtPar:
fixes P :: pi
and Q :: pi
and x :: name
assumes "x ♯ P"
shows "<νx>(P ∥ Q) ≈ P ∥ <νx>Q"
proof -
from assms have "<νx>(P ∥ Q) ∼ P ∥ <νx>Q" by(rule Strong_Late_Bisim_SC.scopeExtPar)
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma scopeExtPar':
fixes P :: pi
and Q :: pi
and x :: name
assumes xFreshQ: "x ♯ Q"
shows "<νx>(P ∥ Q) ≈ (<νx>P) ∥ Q"
proof -
from assms have "<νx>(P ∥ Q) ∼ (<νx>P) ∥ Q" by(rule Strong_Late_Bisim_SC.scopeExtPar')
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma parAssoc:
fixes P :: pi
and Q :: pi
and R :: pi
shows "(P ∥ Q) ∥ R ≈ P ∥ (Q ∥ R)"
proof -
have "(P ∥ Q) ∥ R ∼ P ∥ (Q ∥ R)" by(rule Strong_Late_Bisim_SC.parAssoc)
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma freshRes:
fixes P :: pi
and a :: name
assumes aFreshP: "a ♯ P"
shows "<νa>P ≈ P"
proof -
from assms have "<νa>P ∼ P" by(rule Strong_Late_Bisim_SC.scopeFresh)
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma scopeExtSum:
fixes P :: pi
and Q :: pi
and x :: name
assumes "x ♯ P"
shows "<νx>(P ⊕ Q) ≈ P ⊕ <νx>Q"
proof -
from assms have "<νx>(P ⊕ Q) ∼ P ⊕ <νx>Q" by(rule Strong_Late_Bisim_SC.scopeExtSum)
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma bangSC:
fixes P
shows "!P ≈ P ∥ !P"
proof -
have "!P ∼ P ∥ !P" by(rule Strong_Late_Bisim_SC.bangSC)
thus ?thesis by(rule strongBisimWeakBisim)
qed
end
Theory Weak_Late_Sim_Pres
theory Weak_Late_Sim_Pres
imports Weak_Late_Sim
begin
lemma tauPres:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes PRelQ: "(P, Q) ∈ Rel"
shows "τ.(P) ↝⇧^<Rel> τ.(Q)"
proof(induct rule: simCases)
case(Bound Q' a x)
have "τ.(Q) ⟼a<νx> ≺ Q'" by fact
hence False by auto
thus ?case by simp
next
case(Input Q' a x)
have "τ.(Q) ⟼a<x> ≺ Q'" by fact
hence False by auto
thus ?case by simp
next
case(Free Q' α)
have "τ.(Q) ⟼(α ≺ Q')" by fact
thus ?case using PRelQ
proof(induct rule: tauCases, auto simp add: pi.inject residual.inject)
have "τ.(P) ⟹⇩l⇧^ τ ≺ P" by(rule Tau)
moreover assume "(P, Q') ∈ Rel"
ultimately show "∃P'. τ.(P) ⟹⇩l⇧^ τ ≺ P' ∧ (P', Q') ∈ Rel" by blast
qed
qed
lemma inputPres:
fixes P :: pi
and Q :: pi
and a :: name
and x :: name
and Rel :: "(pi × pi) set"
assumes PRelQ: "∀y. (P[x::=y], Q[x::=y]) ∈ Rel"
and Eqvt: "eqvt Rel"
shows "a<x>.P ↝⇧^<Rel> a<x>.Q"
proof -
show ?thesis using Eqvt
proof(induct rule: simCasesCont[of _ "(P, a, x, Q)"])
case(Bound Q' b y)
have "a<x>.Q ⟼b<νy> ≺ Q'" by fact
hence False by auto
thus ?case by simp
next
case(Input Q' b y)
have "y ♯ (P, a, x, Q)" by fact
hence yFreshP: "(y::name) ♯ P" and yineqx: "y ≠ x" and "y ≠ a" and "y ♯ Q"
by(simp add: fresh_prod)+
have "a<x>.Q ⟼b<y> ≺ Q'" by fact
thus ?case using ‹y ≠ a› ‹y ≠ x› ‹y ♯ Q›
proof(induct rule: inputCases, auto simp add: subject.inject)
have "∀u. ∃P'. a<x>.P ⟹⇩lu in ([(x, y)] ∙ P)→a<y> ≺ P' ∧ (P', ([(x, y)] ∙ Q)[y::=u]) ∈ Rel"
proof(rule allI)
fix u
have "a<x>.P ⟹⇩lu in ([(x, y)] ∙ P)→a<y> ≺ ([(x, y)] ∙ P)[y::=u]" (is "?goal")
proof -
from yFreshP have "a<x>.P = a<y>.([(x, y)] ∙ P)" by(rule Agent.alphaInput)
moreover have "a<y>.([(x, y)] ∙ P) ⟹⇩lu in ([(x, y)] ∙ P)→a<y> ≺ ([(x, y)] ∙ P)[y::=u]"
by(rule Weak_Late_Step_Semantics.Input)
ultimately show ?goal by(simp add: name_swap)
qed
moreover have "(([(x, y)] ∙ P)[y::=u], ([(x, y)] ∙ Q)[y::=u]) ∈ Rel"
proof -
from PRelQ have "(P[x::=u], Q[x::=u]) ∈ Rel" by auto
with ‹y ♯ P› ‹y ♯ Q› show ?thesis by(simp add: renaming)
qed
ultimately show "∃P'. a<x>.P ⟹⇩lu in ([(x, y)] ∙ P)→a<y> ≺ P' ∧ (P', ([(x, y)] ∙ Q)[y::=u]) ∈ Rel"
by blast
qed
thus "∃P''. ∀u. ∃P'. a<x>.P ⟹⇩lu in P''→a<y> ≺ P' ∧ (P', ([(x, y)] ∙ Q)[y::=u]) ∈ Rel" by blast
qed
next
case(Free Q' α)
have "a<x>.Q ⟼α ≺ Q'" by fact
hence False by auto
thus ?case by simp
qed
qed
lemma outputPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes PRelQ: "(P, Q) ∈ Rel"
shows "a{b}.P ↝⇧^<Rel> a{b}.Q"
proof(induct rule: simCases)
case(Bound Q' c x)
have "a{b}.Q ⟼c<νx> ≺ Q'" by fact
hence False by auto
thus ?case by simp
next
case(Input Q' c x)
have "a{b}.Q ⟼c<x> ≺ Q'" by fact
hence False by auto
thus ?case by simp
next
case(Free Q' α)
have "a{b}.Q ⟼α ≺ Q'" by fact
thus "∃P'. a{b}.P ⟹⇩l⇧^ α ≺ P' ∧ (P', Q') ∈ Rel" using PRelQ
proof(induct rule: outputCases, auto simp add: pi.inject residual.inject)
have "a{b}.P ⟹⇩l⇧^ a[b] ≺ P" by(rule Output)
moreover assume "(P, Q') ∈ Rel"
ultimately show "∃P'. a{b}.P ⟹⇩l⇧^ a[b] ≺ P' ∧ (P', Q') ∈ Rel" by blast
qed
qed
lemma matchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes PSimQ: "P ↝⇧^<Rel> Q"
and RelStay: "⋀P Q a. (P, Q) ∈ Rel ⟹ ([a⌢a]P, Q) ∈ Rel"
and RelRel': "Rel ⊆ Rel'"
shows "[a⌢b]P ↝⇧^<Rel'> [a⌢b]Q"
proof(induct rule: simCases)
case(Bound Q' c x)
have "x ♯ [a⌢b]P" by fact
hence xFreshP: "(x::name) ♯ P" by simp
have "[a⌢b]Q ⟼ c<νx> ≺ Q'" by fact
thus ?case
proof(induct rule: matchCases)
case cMatch
have "Q ⟼c<νx> ≺ Q'" by fact
with PSimQ xFreshP obtain P' where PTrans: "P ⟹⇩l⇧^c<νx> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans have "[a⌢a]P ⟹⇩l⇧^c<νx> ≺ P'" by(rule Weak_Late_Semantics.Match)
with P'RelQ' RelRel' show ?case by blast
qed
next
case(Input Q' c x)
have "x ♯ [a⌢b]P" by fact
hence xFreshP: "x ♯ P" by simp
have "[a⌢b]Q ⟼c<x> ≺ Q'" by fact
thus ?case
proof(induct rule: matchCases)
case cMatch
have "Q ⟼ c<x> ≺ Q'" by fact
with PSimQ xFreshP obtain P'' where L1: "∀u. ∃P'. P ⟹⇩lu in P''→c<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel"
by(force intro: simE)
have "∀u. ∃P'. [a⌢a]P ⟹⇩lu in P''→c<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel'"
proof(rule allI)
fix u
from L1 obtain P' where PTrans: "P ⟹⇩lu in P''→c<x> ≺ P'" and P'RelQ': "(P', Q'[x::=u]) ∈ Rel"
by blast
from PTrans have "[a⌢a]P ⟹⇩lu in P''→c<x> ≺ P'" by(rule Weak_Late_Step_Semantics.Match)
with P'RelQ' RelRel' show "∃P'. [a⌢a]P ⟹⇩lu in P''→c<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel'"
by blast
qed
thus ?case by blast
qed
next
case(Free Q' α)
have "[a⌢b]Q ⟼ α ≺ Q'" by fact
thus ?case
proof(induct rule: matchCases)
case cMatch
have "Q ⟼ α ≺ Q'" by fact
with PSimQ obtain P' where PTrans: "P ⟹⇩l⇧^α ≺ P'" and PRel: "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans show ?case
proof(induct rule: transitionCases)
case Step
have "P ⟹⇩lα ≺ P'" by fact
hence "[a⌢a]P ⟹⇩lα ≺ P'" by(rule Weak_Late_Step_Semantics.Match)
with PRel RelRel' show ?case by(force simp add: weakTransition_def)
next
case Stay
have "α ≺ P' = τ ≺ P" by fact
hence alphaEqTau: "α = τ" and PeqP': "P = P'" by(simp add: residual.inject)+
have "[a⌢a]P ⟹⇩l⇧^τ ≺ [a⌢a]P" by(simp add: weakTransition_def)
moreover from PeqP' PRel have "([a⌢a]P, Q') ∈ Rel" by(blast intro: RelStay)
ultimately show ?case using RelRel' alphaEqTau by blast
qed
qed
qed
lemma mismatchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes PSimQ: "P ↝⇧^<Rel> Q"
and RelStay: "⋀P Q a b. ⟦(P, Q) ∈ Rel; a ≠ b⟧ ⟹ ([a≠b]P, Q) ∈ Rel"
and RelRel': "Rel ⊆ Rel'"
shows "[a≠b]P ↝⇧^<Rel'> [a≠b]Q"
proof(cases "a = b")
assume "a = b"
thus ?thesis by(auto simp add: weakSimulation_def)
next
assume aineqb: "a ≠ b"
show ?thesis
proof(induct rule: simCases)
case(Bound Q' c x)
have "x ♯ [a≠b]P" by fact
hence xFreshP: "(x::name) ♯ P" by simp
have "[a≠b]Q ⟼ c<νx> ≺ Q'" by fact
thus ?case
proof(induct rule: mismatchCases)
case cMismatch
have "Q ⟼c<νx> ≺ Q'" by fact
with PSimQ xFreshP obtain P' where PTrans: "P ⟹⇩l⇧^c<νx> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans aineqb have "[a≠b]P ⟹⇩l⇧^c<νx> ≺ P'" by(rule Weak_Late_Semantics.Mismatch)
with P'RelQ' RelRel' show ?case by blast
qed
next
case(Input Q' c x)
have "x ♯ [a≠b]P" by fact
hence xFreshP: "x ♯ P" by simp
have "[a≠b]Q ⟼c<x> ≺ Q'" by fact
thus ?case
proof(induct rule: mismatchCases)
case cMismatch
have "Q ⟼ c<x> ≺ Q'" by fact
with PSimQ xFreshP obtain P'' where L1: "∀u. ∃P'. P ⟹⇩lu in P''→c<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel"
by(force intro: simE)
have "∀u. ∃P'. [a≠b]P ⟹⇩lu in P''→c<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel'"
proof(rule allI)
fix u
from L1 obtain P' where PTrans: "P ⟹⇩lu in P''→c<x> ≺ P'" and P'RelQ': "(P', Q'[x::=u]) ∈ Rel"
by blast
from PTrans aineqb have "[a≠b]P ⟹⇩lu in P''→c<x> ≺ P'" by(rule Weak_Late_Step_Semantics.Mismatch)
with P'RelQ' RelRel' show "∃P'. [a≠b]P ⟹⇩lu in P''→c<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel'"
by blast
qed
thus ?case by blast
qed
next
case(Free Q' α)
have "[a≠b]Q ⟼ α ≺ Q'" by fact
thus ?case
proof(induct rule: mismatchCases)
case cMismatch
have "a ≠ b" by fact
have "Q ⟼α ≺ Q'" by fact
with PSimQ obtain P' where PTrans: "P ⟹⇩l⇧^α ≺ P'" and PRel: "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans show ?case
proof(induct rule: transitionCases)
case Step
have "P ⟹⇩lα ≺ P'" by fact
hence "[a≠b]P ⟹⇩lα ≺ P'" using ‹a ≠ b› by(rule Weak_Late_Step_Semantics.Mismatch)
with PRel RelRel' show ?case by(force simp add: weakTransition_def)
next
case Stay
have "α ≺ P' = τ ≺ P" by fact
hence alphaEqTau: "α = τ" and PeqP': "P = P'" by(simp add: residual.inject)+
have "[a≠b]P ⟹⇩l⇧^τ ≺ [a≠b]P" by(simp add: weakTransition_def)
moreover from PeqP' PRel aineqb have "([a≠b]P, Q') ∈ Rel" by(blast intro: RelStay)
ultimately show ?case using alphaEqTau RelRel' by blast
qed
qed
qed
qed
lemma parCompose:
fixes P :: pi
and Q :: pi
and R :: pi
and T :: pi
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
and Rel'' :: "(pi × pi) set"
assumes PSimQ: "P ↝⇧^<Rel> Q"
and RSimT: "R ↝⇧^<Rel'> T"
and PRelQ: "(P, Q) ∈ Rel"
and RRel'T: "(R, T) ∈ Rel'"
and Par: "⋀P Q R T. ⟦(P, Q) ∈ Rel; (R, T) ∈ Rel'⟧ ⟹ (P ∥ R, Q ∥ T) ∈ Rel''"
and Res: "⋀P Q a. (P, Q) ∈ Rel'' ⟹ (<νa>P, <νa>Q) ∈ Rel''"
and EqvtRel: "eqvt Rel"
and EqvtRel': "eqvt Rel'"
and EqvtRel'': "eqvt Rel''"
shows "P ∥ R ↝⇧^<Rel''> Q ∥ T"
using ‹eqvt Rel''›
proof(induct rule: simCasesCont[where C="(P, Q, R, T)"])
case(Bound Q' a x)
from ‹x ♯ (P, Q, R, T)› have "x ♯ P" and "x ♯ R" and "x ♯ Q" and "x ♯ T" by simp+
from ‹Q ∥ T ⟼ a<νx> ≺ Q'› ‹x ♯ Q› ‹x ♯ T›
show ?case
proof(induct rule: parCasesB)
case(cPar1 Q')
from PSimQ ‹Q ⟼ a<νx> ≺ Q'› ‹x ♯ P› obtain P' where PTrans:"P ⟹⇩l⇧^ a<νx> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans ‹x ♯ R› have "P ∥ R ⟹⇩l⇧^ a<νx> ≺ (P' ∥ R)" by(rule Weak_Late_Semantics.Par1B)
moreover from P'RelQ' RRel'T have "(P' ∥ R, Q' ∥ T) ∈ Rel''" by(rule Par)
ultimately show ?case by blast
next
case(cPar2 T')
from RSimT ‹T ⟼ a<νx> ≺ T'› ‹x ♯ R› obtain R' where RTrans:"R ⟹⇩l⇧^ a<νx> ≺ R'"
and R'Rel'T': "(R', T') ∈ Rel'"
by(blast dest: simE)
from RTrans ‹x ♯ P› ‹x ♯ R› have ParTrans: "P ∥ R ⟹⇩l⇧^ a<νx> ≺ (P ∥ R')"
by(blast intro: Weak_Late_Semantics.Par2B)
moreover from PRelQ R'Rel'T' have "(P ∥ R', Q ∥ T') ∈ Rel''" by(rule Par)
ultimately show ?case by blast
qed
next
case(Input Q' a x)
from ‹x ♯ (P, Q, R, T)› have "x ♯ P" and "x ♯ R" and "x ♯ Q" and "x ♯ T" by simp+
from ‹Q ∥ T ⟼ a<x> ≺ Q'› ‹x ♯ Q› ‹x ♯ T›
show ?case
proof(induct rule: parCasesB)
case(cPar1 Q')
from PSimQ ‹Q ⟼a<x> ≺ Q'› ‹x ♯ P› obtain P''
where L1: "∀u. ∃P'. P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel"
by(blast dest: simE)
have "∀u. ∃P'. P ∥ R ⟹⇩lu in (P'' ∥ R)→a<x> ≺ P' ∧ (P', Q'[x::=u] ∥ T[x::=u]) ∈ Rel''"
proof(rule allI)
fix u
from L1 obtain P' where PTrans:"P ⟹⇩lu in P''→a<x> ≺ P'"
and P'RelQ': "(P', Q'[x::=u]) ∈ Rel" by blast
from PTrans ‹x ♯ R› have "P ∥ R ⟹⇩lu in (P'' ∥ R)→a<x> ≺ (P' ∥ R)"
by(rule Weak_Late_Step_Semantics.Par1B)
moreover from P'RelQ' RRel'T have "(P' ∥ R, Q'[x::=u] ∥ T) ∈ Rel''" by(rule Par)
ultimately show "∃P'. P ∥ R ⟹⇩lu in (P'' ∥ R)→a<x> ≺ P' ∧
(P', Q'[x::=u] ∥ (T[x::=u])) ∈ Rel''" using ‹x ♯ T›
by(force simp add: forget)
qed
thus ?case by force
next
case(cPar2 T')
from RSimT ‹T ⟼a<x> ≺ T'› ‹x ♯ R› obtain R''
where L1: "∀u. ∃R'. R ⟹⇩lu in R''→a<x> ≺ R' ∧ (R', T'[x::=u]) ∈ Rel'"
by(blast dest: simE)
have "∀u. ∃P'. P ∥ R ⟹⇩lu in (P ∥ R'')→a<x> ≺ P' ∧ (P', Q[x::=u] ∥ T'[x::=u]) ∈ Rel''"
proof(rule allI)
fix u
from L1 obtain R' where RTrans:"R ⟹⇩lu in R''→a<x> ≺ R'"
and R'Rel'T': "(R', T'[x::=u]) ∈ Rel'" by blast
from RTrans ‹x ♯ P› have ParTrans: "P ∥ R ⟹⇩lu in (P ∥ R'')→a<x> ≺ (P ∥ R')"
by(rule Weak_Late_Step_Semantics.Par2B)
moreover from PRelQ R'Rel'T' have "(P ∥ R', Q ∥ T'[x::=u]) ∈ Rel''" by(rule Par)
ultimately show "∃P'. P ∥ R ⟹⇩lu in (P ∥ R'')→a<x> ≺ P' ∧
(P', Q[x::=u] ∥ T'[x::=u]) ∈ Rel''" using ‹x ♯ Q›
by(force simp add: forget)
qed
thus ?case by force
qed
next
case(Free QT' α)
have "Q ∥ T ⟼ α ≺ QT'" by fact
thus ?case
proof(induct rule: parCasesF[of _ _ _ _ _ "(P, R)"])
case(cPar1 Q')
have "Q ⟼ α ≺ Q'" by fact
with PSimQ obtain P' where PTrans: "P ⟹⇩l⇧^ α ≺ P'" and PRel: "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans have Trans: "P ∥ R ⟹⇩l⇧^ α ≺ P' ∥ R" by(rule Weak_Late_Semantics.Par1F)
moreover from PRel RRel'T have "(P' ∥ R, Q' ∥ T) ∈ Rel''" by(blast intro: Par)
ultimately show ?case by blast
next
case(cPar2 T')
have "T ⟼ α ≺ T'" by fact
with RSimT obtain R' where RTrans: "R ⟹⇩l⇧^ α ≺ R'" and RRel: "(R', T') ∈ Rel'"
by(blast dest: simE)
from RTrans have Trans: "P ∥ R ⟹⇩l⇧^ α ≺ P ∥ R'" by(rule Weak_Late_Semantics.Par2F)
moreover from PRelQ RRel have "(P ∥ R', Q ∥ T') ∈ Rel''" by(blast intro: Par)
ultimately show ?case by blast
next
case(cComm1 Q' T' a b x)
have QTrans: "Q ⟼ a<x> ≺ Q'" and TTrans: "T ⟼ a[b] ≺ T'" by fact+
have "x ♯ (P, R)" by fact
hence xFreshP: "x ♯ P" by(simp add: fresh_prod)
from PSimQ QTrans xFreshP obtain P' P'' where PTrans: "P ⟹⇩lb in P''→a<x> ≺ P'"
and P'RelQ': "(P', Q'[x::=b]) ∈ Rel"
by(blast dest: simE)
from RSimT TTrans obtain R' where RTrans: "R ⟹⇩l⇧^a[b] ≺ R'"
and RRel: "(R', T') ∈ Rel'"
by(blast dest: simE)
from PTrans RTrans have "P ∥ R ⟹⇩l⇧^ τ ≺ P' ∥ R'" by(rule Weak_Late_Semantics.Comm1)
moreover from P'RelQ' RRel have "(P' ∥ R', Q'[x::=b] ∥ T') ∈ Rel''" by(rule Par)
ultimately show ?case by blast
next
case(cComm2 Q' T' a b x)
have QTrans: "Q ⟼a[b] ≺ Q'" and TTrans: "T ⟼a<x> ≺ T'" by fact+
have "x ♯ (P, R)" by fact
hence xFreshR: "x ♯ R" by(simp add: fresh_prod)
from PSimQ QTrans obtain P' where PTrans: "P ⟹⇩l⇧^a[b] ≺ P'"
and PRel: "(P', Q') ∈ Rel"
by(blast dest: simE)
from RSimT TTrans xFreshR obtain R' R'' where RTrans: "R ⟹⇩lb in R''→a<x> ≺ R'"
and R'Rel'T': "(R', T'[x::=b]) ∈ Rel'"
by(blast dest: simE)
from PTrans RTrans have "P ∥ R ⟹⇩l⇧^ τ ≺ P' ∥ R'" by(rule Weak_Late_Semantics.Comm2)
moreover from PRel R'Rel'T' have "(P' ∥ R', Q' ∥ T'[x::=b]) ∈ Rel''" by(rule Par)
ultimately show ?case by blast
next
case(cClose1 Q' T' a x y)
have QTrans: "Q ⟼a<x> ≺ Q'" and TTrans: "T ⟼a<νy> ≺ T'" by fact+
have "x ♯ (P, R)" and "y ♯ (P, R)" by fact+
hence xFreshP: "x ♯ P" and yFreshR: "y ♯ R" and yFreshP: "y ♯ P" by(simp add: fresh_prod)+
from PSimQ QTrans xFreshP obtain P' P'' where PTrans: "P ⟹⇩ly in P''→a<x> ≺ P'"
and P'RelQ': "(P', Q'[x::=y]) ∈ Rel"
by(blast dest: simE)
from RSimT TTrans yFreshR obtain R' where RTrans: "R ⟹⇩l⇧^a<νy> ≺ R'"
and R'Rel'T': "(R', T') ∈ Rel'"
by(blast dest: simE)
from PTrans RTrans yFreshP yFreshR have Trans: "P ∥ R ⟹⇩l⇧^ τ ≺ <νy>(P' ∥ R')"
by(rule Weak_Late_Semantics.Close1)
moreover from P'RelQ' R'Rel'T' have "(<νy>(P' ∥ R'), <νy>(Q'[x::=y] ∥ T')) ∈ Rel''"
by(blast intro: Par Res)
ultimately show ?case by blast
next
case(cClose2 Q' T' a x y)
have QTrans: "Q ⟼a<νy> ≺ Q'" and TTrans: "T ⟼a<x> ≺ T'" by fact+
have "x ♯ (P, R)" and "y ♯ (P, R)" by fact+
hence xFreshR: "x ♯ R" and yFreshP: "y ♯ P" and yFreshR: "y ♯ R" by(simp add: fresh_prod)+
from PSimQ QTrans yFreshP obtain P' where PTrans: "P ⟹⇩l⇧^a<νy> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from RSimT TTrans xFreshR obtain R' R'' where RTrans: "R ⟹⇩ly in R''→a<x> ≺ R'"
and R'Rel'T': "(R', T'[x::=y]) ∈ Rel'"
by(blast dest: simE)
from PTrans RTrans yFreshP yFreshR have Trans: "P ∥ R ⟹⇩l⇧^τ ≺ <νy>(P' ∥ R')"
by(rule Weak_Late_Semantics.Close2)
moreover from P'RelQ' R'Rel'T' have "(<νy>(P' ∥ R'), <νy>(Q' ∥ T'[x::=y])) ∈ Rel''"
by(blast intro: Par Res)
ultimately show ?case by blast
qed
qed
lemma parPres:
fixes P :: pi
and Q :: pi
and R :: pi
and a :: name
and b :: name
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes PSimQ: "P ↝⇧^<Rel> Q"
and PRelQ: "(P, Q) ∈ Rel"
and Par: "⋀P Q R. (P, Q) ∈ Rel ⟹ (P ∥ R, Q ∥ R) ∈ Rel'"
and Res: "⋀P Q a. (P, Q) ∈ Rel' ⟹ (<νa>P, <νa>Q) ∈ Rel'"
and EqvtRel: "eqvt Rel"
and EqvtRel': "eqvt Rel'"
shows "P ∥ R ↝⇧^<Rel'> Q ∥ R"
proof -
note PSimQ
moreover have RSimR: "R ↝⇧^<Id> R" by(auto intro: reflexive)
moreover note PRelQ moreover have "(R, R) ∈ Id" by auto
moreover from Par have "⋀P Q R T. ⟦(P, Q) ∈ Rel; (R, T) ∈ Id⟧ ⟹ (P ∥ R, Q ∥ T) ∈ Rel'"
by auto
moreover note Res ‹eqvt Rel›
moreover have "eqvt Id" by(auto simp add: eqvt_def)
ultimately show ?thesis using EqvtRel' by(rule parCompose)
qed
lemma resPres:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and x :: name
and Rel' :: "(pi × pi) set"
assumes PSimQ: "P ↝⇧^<Rel> Q"
and ResRel: "⋀(P::pi) (Q::pi) (x::name). (P, Q) ∈ Rel ⟹ (<νx>P, <νx>Q) ∈ Rel'"
and RelRel': "Rel ⊆ Rel'"
and EqvtRel: "eqvt Rel"
and EqvtRel': "eqvt Rel'"
shows "<νx>P ↝⇧^<Rel'> <νx>Q"
proof -
from EqvtRel' show ?thesis
proof(induct rule: simCasesCont[of _ "(P, Q, x)"])
case(Bound Q' a y)
have Trans: "<νx>Q ⟼a<νy> ≺ Q'" by fact
have "y ♯ (P, Q, x)" by fact
hence yineqx: "y ≠ x" and yFreshP: "y ♯ P" and "y ♯ Q" by(simp add: fresh_prod)+
from Trans ‹y ≠ x› ‹y ♯ Q› show ?case
proof(induct rule: resCasesB)
case(cOpen a Q')
have QTrans: "Q ⟼a[x] ≺ Q'" and aineqx: "a ≠ x" by fact+
from PSimQ QTrans obtain P' where PTrans: "P ⟹⇩l⇧^a[x] ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
have "<νx>P ⟹⇩l⇧^a<νy> ≺ ([(y, x)] ∙ P')"
proof -
from PTrans aineqx have "<νx>P ⟹⇩l⇧^a<νx> ≺ P'" by(rule Weak_Late_Semantics.Open)
moreover from PTrans yFreshP have "y ♯ P'" by(force intro: freshTransition)
ultimately show ?thesis by(simp add: alphaBoundResidual name_swap)
qed
moreover from EqvtRel P'RelQ' RelRel' have "([(y, x)] ∙ P', [(y, x)] ∙ Q') ∈ Rel'"
by(blast intro: eqvtRelI)
ultimately show ?case by blast
next
case(cRes Q')
have QTrans: "Q ⟼a<νy> ≺ Q'" by fact
from ‹x ♯ BoundOutputS a› have "x ≠ a" by simp
from PSimQ yFreshP QTrans obtain P' where PTrans: "P ⟹⇩l⇧^a<νy> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans ‹x ≠ a› yineqx yFreshP have ResTrans: "<νx>P ⟹⇩l⇧^a<νy> ≺ (<νx>P')"
by(blast intro: Weak_Late_Semantics.ResB)
moreover from P'RelQ' have "((<νx>P'), (<νx>Q')) ∈ Rel'"
by(rule ResRel)
ultimately show ?case by blast
qed
next
case(Input Q' a y)
have "y ♯ (P, Q, x)" by fact
hence yineqx: "y ≠ x" and yFreshP: "y ♯ P" and "y ♯ Q" by(simp add: fresh_prod)+
have "<νx>Q ⟼a<y> ≺ Q'" by fact
thus ?case using yineqx ‹y ♯ Q›
proof(induct rule: resCasesB)
case(cOpen a Q')
thus ?case by simp
next
case(cRes Q')
have QTrans: "Q ⟼a<y> ≺ Q'" by fact
from ‹x ♯ InputS a› have "x ≠ a" by simp
from PSimQ QTrans yFreshP obtain P''
where L1: "∀u. ∃P'. P ⟹⇩lu in P''→a<y> ≺ P' ∧ (P', Q'[y::=u]) ∈ Rel"
by(blast dest: simE)
have "∀u. ∃P'. <νx>P ⟹⇩lu in (<νx>P'')→a<y> ≺ P' ∧ (P', (<νx>Q')[y::=u]) ∈ Rel'"
proof(rule allI)
fix u
show "∃P'. <νx>P ⟹⇩lu in <νx>P''→a<y> ≺ P' ∧ (P', (<νx>Q')[y::=u]) ∈ Rel'"
proof(cases "x=u")
assume xequ: "x=u"
have "∃c::name. c ♯ (P, P'', Q', x, y, a)" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshP: "c ♯ P" and cFreshP'': "c ♯ P''" and cFreshQ': "c ♯ Q'"
and cineqx: "c ≠ x" and cineqy: "c ≠ y" and cineqa: "c ≠ a"
by(force simp add: fresh_prod)
from L1 obtain P' where PTrans: "P ⟹⇩lc in P''→a<y> ≺ P'"
and P'RelQ': "(P', Q'[y::=c]) ∈ Rel"
by blast
have "<νx>P ⟹⇩lu in (<νx>P'')→a<y> ≺ <νc>([(x, c)] ∙ P')"
proof -
from PTrans yineqx ‹x ≠ a› cineqx have "<νx>P ⟹⇩lc in (<νx>P'')→a<y> ≺ <νx>P'"
by(blast intro: Weak_Late_Step_Semantics.ResB)
hence "([(x, c)] ∙ <νx>P) ⟹⇩l([(x, c)] ∙ c) in ([(x, c)] ∙ <νx>P'')→([(x, c)] ∙ a)<([(x, c)] ∙ y)> ≺ [(x, c)] ∙ <νx>P'"
by(rule Weak_Late_Step_Semantics.eqvtI)
moreover from cFreshP have "<νc>([(x, c)] ∙ P) = <νx>P" by(simp add: alphaRes)
moreover from cFreshP'' have "<νc>([(x, c)] ∙ P'') = <νx>P''" by(simp add: alphaRes)
ultimately show ?thesis using ‹x ≠ a› cineqa yineqx cineqy cineqx xequ by(simp add: name_calc)
qed
moreover have "(<νc>([(x, c)] ∙ P'), (<νx>Q')[y::=u]) ∈ Rel'"
proof -
from P'RelQ' have "(<νx>P', <νx>(Q'[y::=c])) ∈ Rel'" by(rule ResRel)
with EqvtRel' have "([(x, c)] ∙ <νx>P', [(x, c)] ∙ <νx>(Q'[y::=c])) ∈ Rel'" by(rule eqvtRelI)
with cineqy yineqx cineqx have "(<νc>([(x, c)] ∙ P'), (<νc>([(x, c)] ∙ Q'))[y::=x]) ∈ Rel'"
by(simp add: name_calc eqvt_subs)
with cFreshQ' xequ show ?thesis by(simp add: alphaRes)
qed
ultimately show ?thesis by blast
next
assume xinequ: "x ≠ u"
from L1 obtain P' where PTrans: "P ⟹⇩lu in P''→a<y> ≺ P'"
and P'RelQ': "(P', Q'[y::=u]) ∈ Rel" by blast
from PTrans ‹x ≠ a› yineqx xinequ have "<νx>P ⟹⇩lu in (<νx>P'')→a<y> ≺ <νx>P'"
by(blast intro: Weak_Late_Step_Semantics.ResB)
moreover from P'RelQ' xinequ yineqx have "(<νx>P', (<νx>Q')[y::=u]) ∈ Rel'"
by(force intro: ResRel)
ultimately show ?thesis by blast
qed
qed
thus ?case by blast
qed
next
case(Free Q' α)
have "<νx>Q ⟼ α ≺ Q'" by fact
thus ?case
proof(induct rule: resCasesF)
case(cRes Q')
have "Q ⟼α ≺ Q'" by fact
with PSimQ obtain P' where PTrans: "P ⟹⇩l⇧^ α ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
have "<νx>P ⟹⇩l⇧^α ≺ <νx>P'"
proof -
have xFreshAlpha: "x ♯ α" by fact
with PTrans show ?thesis by(rule ResF)
qed
moreover from P'RelQ' have "(<νx>P', <νx>Q') ∈ Rel'" by(rule ResRel)
ultimately show ?case by blast
qed
qed
qed
lemma resChainI:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and lst :: "name list"
assumes eqvtRel: "eqvt Rel"
and Res: "⋀P Q a. (P, Q) ∈ Rel ⟹ (<νa>P, <νa>Q) ∈ Rel"
and PRelQ: "P ↝⇧^<Rel> Q"
shows "(resChain lst) P ↝⇧^<Rel> (resChain lst) Q"
proof -
show ?thesis
proof(induct lst)
from PRelQ show "resChain [] P ↝⇧^<Rel> resChain [] Q" by simp
next
fix a lst
assume IH: "(resChain lst P) ↝⇧^<Rel> (resChain lst Q)"
moreover from Res have "⋀P Q a. (P, Q) ∈ Rel ⟹ (<νa>P, <νa>Q) ∈ Rel"
by simp
moreover have "Rel ⊆ Rel" by simp
ultimately have "<νa>(resChain lst P) ↝⇧^<Rel> <νa>(resChain lst Q)" using eqvtRel
by(rule_tac resPres)
thus "resChain (a # lst) P ↝⇧^<Rel> resChain (a # lst) Q"
by simp
qed
qed
lemma bangPres:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
assumes PSimQ: "P ↝⇧^<Rel> Q"
and PRelQ: "(P, Q) ∈ Rel"
and Sim: "⋀P Q. (P, Q) ∈ Rel ⟹ P ↝⇧^<Rel> Q"
and ParComp: "⋀P Q R T. ⟦(P, Q) ∈ Rel; (R, T) ∈ Rel'⟧ ⟹ (P ∥ R, Q ∥ T) ∈ Rel'"
and Res: "⋀P Q x. (P, Q) ∈ Rel' ⟹ (<νx>P, <νx>Q) ∈ Rel'"
and RelStay: "⋀P Q. (P ∥ !P, Q) ∈ Rel' ⟹ (!P, Q) ∈ Rel'"
and BangRelRel': "(bangRel Rel) ⊆ Rel'"
and eqvtRel': "eqvt Rel'"
shows "!P ↝⇧^<Rel'> !Q"
proof -
have "⋀Rs P. ⟦!Q ⟼ Rs; (P, !Q) ∈ bangRel Rel⟧ ⟹ weakSimAct P Rs P Rel'"
proof -
fix Rs P
assume "!Q ⟼ Rs" and "(P, !Q) ∈ bangRel Rel"
thus "weakSimAct P Rs P Rel'"
proof(nominal_induct avoiding: P rule: bangInduct)
case(cPar1B aa x Q')
have QTrans: "Q ⟼aa«x» ≺ Q'" and xFreshQ: "x ♯ Q" by fact+
have "(P, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ P" by fact+
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBangRelT: "(R, !Q) ∈ bangRel Rel" by fact+
have "x ♯ P ∥ R" by fact
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by simp+
from PRelQ have PSimQ: "P ↝⇧^<Rel> Q" by(rule Sim)
from eqvtRel' show ?case
proof(induct rule: simActBoundCases)
case(Input a)
have "aa = InputS a" by fact
with PSimQ QTrans xFreshP obtain P''
where L1: "∀u. ∃P'. P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel"
by(blast dest: simE)
have "∀u. ∃P'. P ∥ R ⟹⇩lu in (P'' ∥ R)→a<x> ≺ P' ∧ (P', (Q' ∥ !Q)[x::=u]) ∈ Rel'"
proof(rule allI)
fix u
from L1 obtain P' where PTrans: "P ⟹⇩lu in P''→a<x> ≺ P'"
and P'RelQ': "(P', Q'[x::=u]) ∈ Rel"
by blast
from PTrans xFreshR have "P ∥ R ⟹⇩lu in (P'' ∥ R)→a<x>≺ P' ∥ R"
by(rule Weak_Late_Step_Semantics.Par1B)
moreover have "(P' ∥ R, (Q' ∥ !Q)[x::=u]) ∈ Rel'"
proof -
from P'RelQ' RBangRelT have "(P' ∥ R, Q'[x::=u] ∥ !Q) ∈ bangRel Rel"
by(rule Rel.BRPar)
with xFreshQ BangRelRel' show ?thesis by(auto simp add: forget)
qed
ultimately show "∃P'. P ∥ R ⟹⇩lu in (P'' ∥ R)→a<x> ≺ P' ∧
(P', (Q' ∥ !Q)[x::=u]) ∈ Rel'" by blast
qed
thus ?case by blast
next
case(BoundOutput a)
have "aa = BoundOutputS a" by fact
with PSimQ QTrans xFreshP obtain P' where PTrans: "P ⟹⇩l⇧^a<νx> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans xFreshR have "P ∥ R ⟹⇩l⇧^a<νx>≺ P' ∥ R"
by(rule Weak_Late_Semantics.Par1B)
moreover from P'RelQ' RBangRelT BangRelRel' have "(P' ∥ R, Q' ∥ !Q) ∈ Rel'"
by(blast intro: Rel.BRPar)
ultimately show ?case by blast
qed
qed
next
case(cPar1F α Q' P)
have QTrans: "Q ⟼α ≺ Q'" by fact
have "(P, Q ∥ !Q) ∈ bangRel Rel" by fact
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact+
show ?case
proof(induct rule: simActFreeCases)
case Der
from PRelQ have "P ↝⇧^<Rel> Q" by(rule Sim)
with QTrans obtain P' where PTrans: "P ⟹⇩l⇧^α ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans have "P ∥ R ⟹⇩l⇧^α ≺ P' ∥ R" by(rule Weak_Late_Semantics.Par1F)
moreover from P'RelQ' RBangRelQ have "(P' ∥ R, Q' ∥ !Q) ∈ bangRel Rel"
by(rule Rel.BRPar)
ultimately show ?case using BangRelRel' by blast
qed
qed
next
case(cPar2B aa x Q' P)
have IH: "⋀P. (P, !Q) ∈ bangRel Rel ⟹ weakSimAct P (aa«x» ≺ Q') P Rel'" by fact
have xFreshQ: "x ♯ Q" by fact
have "(P, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ P" by fact+
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact+
have "x ♯ P ∥ R" by fact
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by simp+
from eqvtRel' show ?case
proof(induct rule: simActBoundCases)
case(Input a)
have "aa = InputS a" by fact
with RBangRelQ IH have "weakSimAct R (a<x> ≺ Q') R Rel'" by blast
with xFreshR obtain R'' where L1: "∀u. ∃R'. R ⟹⇩lu in R''→a<x> ≺ R' ∧ (R', Q'[x::=u]) ∈ Rel'"
by(force simp add: weakSimAct_def)
have "∀u. ∃P'. P ∥ R ⟹⇩lu in (P ∥ R'')→a<x> ≺ P' ∧ (P', (Q ∥ Q')[x::=u]) ∈ Rel'"
proof(rule allI)
fix u
from L1 obtain R' where RTrans: "R ⟹⇩lu in R''→a<x> ≺ R'"
and R'Rel'Q': "(R', Q'[x::=u]) ∈ Rel'"
by blast
from RTrans xFreshP have "P ∥ R ⟹⇩lu in (P ∥ R'')→a<x> ≺ P ∥ R'"
by(rule Weak_Late_Step_Semantics.Par2B)
moreover have "(P ∥ R', (Q ∥ Q')[x::=u]) ∈ Rel'"
proof -
from PRelQ R'Rel'Q' have "(P ∥ R', Q ∥ Q'[x::=u]) ∈ Rel'"
by(rule ParComp)
with xFreshQ show ?thesis by(simp add: forget)
qed
ultimately show "∃P'. P ∥ R ⟹⇩lu in (P ∥ R'')→a<x> ≺ P' ∧ (P', (Q ∥ Q')[x::=u]) ∈ Rel'"
by blast
qed
thus ?case by blast
next
case(BoundOutput a)
have "aa = BoundOutputS a" by fact
with IH RBangRelQ have "weakSimAct R (a<νx> ≺ Q') R Rel'" by blast
with xFreshR obtain R' where RTrans: "R ⟹⇩l⇧^a<νx> ≺ R'" and R'BangRelQ': "(R', Q') ∈ Rel'"
by(simp add: weakSimAct_def, blast)
from RTrans xFreshP have "P ∥ R ⟹⇩l⇧^a<νx> ≺ P ∥ R'"
by(auto intro: Weak_Late_Semantics.Par2B)
moreover from PRelQ R'BangRelQ' have "(P ∥ R', Q ∥ Q') ∈ Rel'"
by(rule ParComp)
ultimately show ?case by blast
qed
qed
next
case(cPar2F α Q' P)
have IH: "⋀P. (P, !Q) ∈ bangRel Rel ⟹ weakSimAct P (α ≺ Q') P Rel'" by fact
have "(P, Q ∥ !Q) ∈ bangRel Rel" by fact
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact+
show ?case
proof(induct rule: simActFreeCases)
case Der
from RBangRelQ have "weakSimAct R (α ≺ Q') R Rel'" by(rule IH)
then obtain R' where RTrans: "R ⟹⇩l⇧^α ≺ R'" and R'RelQ': "(R', Q') ∈ Rel'"
by(simp add: weakSimAct_def, blast)
from RTrans have "P ∥ R ⟹⇩l⇧^α ≺ P ∥ R'" by(rule Weak_Late_Semantics.Par2F)
moreover from PRelQ R'RelQ' have "(P ∥ R', Q ∥ Q') ∈ Rel'" by(rule ParComp)
ultimately show ?case by blast
qed
qed
next
case(cComm1 a x Q' b Q'' P)
have QTrans: "Q ⟼ a<x> ≺ Q'" by fact
have IH: "⋀P. (P, !Q) ∈ bangRel Rel ⟹ weakSimAct P (a[b] ≺ Q'') P Rel'" by fact
have "(P, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ P" by fact+
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact+
have "x ♯ P ∥ R" by fact
hence xFreshP: "x ♯ P" by simp
show ?case
proof(induct rule: simActFreeCases)
case Der
from PRelQ have "P ↝⇧^<Rel> Q" by(rule Sim)
with QTrans xFreshP obtain P' P'' where PTrans: "P ⟹⇩lb in P''→a<x> ≺ P'"
and P'RelQ': "(P', Q'[x::=b]) ∈ Rel"
by(blast dest: simE)
from RBangRelQ have "weakSimAct R (a[b] ≺ Q'') R Rel'" by(rule IH)
then obtain R' where RTrans: "R ⟹⇩l⇧^a[b] ≺ R'"
and R'RelQ'': "(R', Q'') ∈ Rel'"
by(simp add: weakSimAct_def, blast)
from PTrans RTrans have "P ∥ R ⟹⇩l⇧^τ ≺ (P' ∥ R')"
by(rule Weak_Late_Semantics.Comm1)
moreover from P'RelQ' R'RelQ'' have "(P' ∥ R', Q'[x::=b] ∥ Q'') ∈ Rel'"
by(rule ParComp)
ultimately show ?case by blast
qed
qed
next
case(cComm2 a b Q' x Q'' P)
have QTrans: "Q ⟼a[b] ≺ Q'" by fact
have IH: "⋀P. (P, !Q) ∈ bangRel Rel ⟹ weakSimAct P (a<x> ≺ Q'') P Rel'" by fact
have "(P, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ P" by fact+
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact+
have "x ♯ P ∥ R" by fact
hence xFreshR: "x ♯ R" by simp
show ?case
proof(induct rule: simActFreeCases)
case Der
from PRelQ have "P ↝⇧^<Rel> Q" by(rule Sim)
with QTrans obtain P' where PTrans: "P ⟹⇩l⇧^a[b] ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from RBangRelQ have "weakSimAct R (a<x> ≺ Q'') R Rel'" by(rule IH)
with xFreshR obtain R' R'' where RTrans: "R ⟹⇩lb in R''→a<x> ≺ R'"
and R'BangRelQ'': "(R', Q''[x::=b]) ∈ Rel'"
by(simp add: weakSimAct_def, blast)
from PTrans RTrans have "P ∥ R ⟹⇩l⇧^τ ≺ (P' ∥ R')"
by(rule Weak_Late_Semantics.Comm2)
moreover from P'RelQ' R'BangRelQ'' have "(P' ∥ R', Q' ∥ Q''[x::=b]) ∈ Rel'"
by(rule ParComp)
ultimately show ?case by blast
qed
qed
next
case(cClose1 a x Q' y Q'' P)
have QTrans: "Q ⟼ a<x> ≺ Q'" by fact
have IH: "⋀P. (P, !Q) ∈ bangRel Rel ⟹ weakSimAct P (a<νy> ≺ Q'') P Rel'" by fact
have "(P, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ P" and "y ♯ P" by fact+
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact+
have "x ♯ P ∥ R" by fact
hence xFreshP: "x ♯ P" by simp
have "y ♯ P ∥ R" by fact
hence yFreshR: "y ♯ R" and yFreshP: "y ♯ P" by simp+
show ?case
proof(induct rule: simActFreeCases)
case Der
from PRelQ have "P ↝⇧^<Rel> Q" by(rule Sim)
with QTrans xFreshP obtain P' P'' where PTrans: "P ⟹⇩ly in P''→a<x> ≺ P'"
and P'RelQ': "(P', Q'[x::=y]) ∈ Rel"
by(blast dest: simE)
from RBangRelQ have "weakSimAct R (a<νy> ≺ Q'') R Rel'" by(rule IH)
with yFreshR obtain R' where RTrans: "R ⟹⇩l⇧^a<νy> ≺ R'"
and R'RelQ'': "(R', Q'') ∈ Rel'"
by(simp add: weakSimAct_def, blast)
from PTrans RTrans yFreshP yFreshR have "P ∥ R ⟹⇩l⇧^τ ≺ <νy>(P' ∥ R')"
by(rule Weak_Late_Semantics.Close1)
moreover from P'RelQ' R'RelQ'' have "(<νy>(P' ∥ R'), <νy>(Q'[x::=y] ∥ Q'')) ∈ Rel'"
by(force intro: ParComp Res)
ultimately show ?case by blast
qed
qed
next
case(cClose2 a y Q' x Q'' P)
have QTrans: "Q ⟼ a<νy> ≺ Q'" by fact
have IH: "⋀P. (P, !Q) ∈ bangRel Rel ⟹ weakSimAct P (a<x> ≺ Q'') P Rel'" by fact
have "(P, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ P" and "y ♯ P" by fact+
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact+
have "x ♯ P ∥ R" by fact
hence xFreshR: "x ♯ R" by simp
have "y ♯ P ∥ R" by fact
hence yFreshP: "y ♯ P" and yFreshR: "y ♯ R" by simp+
show ?case
proof(induct rule: simActFreeCases)
case Der
from PRelQ have "P ↝⇧^<Rel> Q" by(rule Sim)
with QTrans yFreshP obtain P' where PTrans: "P ⟹⇩l⇧^a<νy> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from RBangRelQ have "weakSimAct R (a<x> ≺ Q'') R Rel'" by(rule IH)
with xFreshR obtain R' R'' where RTrans: "R ⟹⇩ly in R''→a<x> ≺ R'"
and R'RelQ'': "(R', Q''[x::=y]) ∈ Rel'"
by(simp add: weakSimAct_def, blast)
from PTrans RTrans yFreshP yFreshR have "P ∥ R ⟹⇩l⇧^τ ≺ <νy>(P' ∥ R')"
by(rule Weak_Late_Semantics.Close2)
moreover from P'RelQ' R'RelQ'' have "(<νy>(P' ∥ R'), <νy>(Q' ∥ Q''[x::=y])) ∈ Rel'"
by(force intro: ParComp Res)
ultimately show ?case by blast
qed
qed
next
case(cBang Rs)
have IH: "⋀P. (P, Q ∥ !Q) ∈ bangRel Rel ⟹ weakSimAct P Rs P Rel'" by fact
have "(P, !Q) ∈ bangRel Rel" by fact
thus ?case
proof(induct rule: BRBangCases)
case(BRBang P)
have PRelQ: "(P, Q) ∈ Rel" by fact
hence "(!P, !Q) ∈ bangRel Rel" by(rule Rel.BRBang)
with PRelQ have "(P ∥ !P, Q ∥ !Q) ∈ bangRel Rel" by(rule Rel.BRPar)
hence "weakSimAct (P ∥ !P) Rs (P ∥ !P) Rel'" by(rule IH)
thus ?case
proof(simp (no_asm) add: weakSimAct_def, auto)
fix Q' a x
assume "weakSimAct (P ∥ !P) (a<νx> ≺ Q') (P ∥ !P) Rel'" and "x ♯ P"
then obtain P' where PTrans: "(P ∥ !P) ⟹⇩l⇧^a<νx> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel'"
by(simp add: weakSimAct_def, blast)
from PTrans have "!P ⟹⇩l⇧^a<νx> ≺ P'"
by(force intro: Weak_Late_Step_Semantics.Bang simp add: weakTransition_def)
with P'RelQ' show "∃P'. !P ⟹⇩l⇧^a<νx> ≺ P' ∧ (P', Q') ∈ Rel'" by blast
next
fix Q' a x
assume "weakSimAct (P ∥ !P) (a<x> ≺ Q') (P ∥ !P) Rel'" and "x ♯ P"
then obtain P'' where L1: "∀u. ∃P'. P ∥ !P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel'"
by(simp add: weakSimAct_def, blast)
have "∀u. ∃P'. !P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel'"
proof(rule allI)
fix u
from L1 obtain P' where PTrans: "P ∥ !P ⟹⇩lu in P''→a<x> ≺ P'"
and P'RelQ': "(P', Q'[x::=u]) ∈ Rel'"
by blast
from PTrans have "!P ⟹⇩lu in P''→a<x> ≺ P'" by(rule Weak_Late_Step_Semantics.Bang)
with P'RelQ' show "∃P'. !P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel'" by blast
qed
thus "∃P''. ∀u. ∃P'. !P ⟹⇩lu in P''→a<x> ≺ P' ∧ (P', Q'[x::=u]) ∈ Rel'" by blast
next
fix Q' α
assume "weakSimAct (P ∥ !P) (α ≺ Q') (P ∥ !P) Rel'"
then obtain P' where PTrans: "(P ∥ !P) ⟹⇩l⇧^α ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel'"
by(simp add: weakSimAct_def, blast)
from PTrans show "∃P'. !P ⟹⇩l⇧^α ≺ P' ∧ (P', Q') ∈ Rel'"
proof(induct rule: transitionCases)
case Step
have "P ∥ !P ⟹⇩lα ≺ P'" by fact
hence "!P ⟹⇩lα ≺ P'" by(rule Weak_Late_Step_Semantics.Bang)
with P'RelQ' show ?case by(force simp add: weakTransition_def)
next
case Stay
have "α ≺ P' = τ ≺ P ∥ !P" by fact
hence αeqτ: "α = τ" and P'eqP: "P' = P ∥ !P" by(simp add: residual.inject)+
have "!P ⟹⇩l⇧^τ ≺ !P" by(simp add: weakTransition_def)
moreover from P'eqP P'RelQ' have "(!P, Q') ∈ Rel'" by(blast intro: RelStay)
ultimately show ?case using αeqτ by blast
qed
qed
qed
qed
qed
moreover from PRelQ have "(!P, !Q) ∈ bangRel Rel" by(rule Rel.BRBang)
ultimately show ?thesis by(simp add: simDef)
qed
end
Theory Weak_Late_Bisim_Pres
theory Weak_Late_Bisim_Pres
imports Weak_Late_Bisim_SC Weak_Late_Sim_Pres Strong_Late_Bisim_SC
begin
lemma tauPres:
fixes P :: pi
and Q :: pi
assumes "P ≈ Q"
shows "τ.(P) ≈ τ.(Q)"
proof -
let ?X = "{(τ.(P), τ.(Q)) | P Q. P ≈ Q}"
from assms have "(τ.(P), τ.(Q)) ∈ ?X" by auto
thus ?thesis
by(coinduct rule: weakBisimCoinduct)
(auto simp add: pi.inject intro: Weak_Late_Sim_Pres.tauPres symmetric)
qed
lemma inputPres:
fixes P :: pi
and Q :: pi
and a :: name
and x :: name
assumes PSimQ: "∀y. P[x::=y] ≈ Q[x::=y]"
shows "a<x>.P ≈ a<x>.Q"
proof -
let ?X = "{(a<x>.P, a<x>.Q) | a x P Q. ∀y. P[x::=y] ≈ Q[x::=y]}"
{
fix axP axQ p
assume "(axP, axQ) ∈ ?X"
then obtain a x P Q where A: "∀y. P[x::=y] ≈ Q[x::=y]" and B: "axP = a<x>.P" and C: "axQ = a<x>.Q"
by auto
have "⋀y. ((p::name prm) ∙ P)[(p ∙ x)::=y] ≈ (p ∙ Q)[(p ∙ x)::=y]"
proof -
fix y
from A have "P[x::=(rev p ∙ y)] ≈ Q[x::=(rev p ∙ y)]"
by blast
hence "(p ∙ (P[x::=(rev p ∙ y)])) ≈ p ∙ (Q[x::=(rev p ∙ y)])"
by(rule eqvtI)
thus "(p ∙ P)[(p ∙ x)::=y] ≈ (p ∙ Q)[(p ∙ x)::=y]"
by(simp add: eqvts pt_pi_rev[OF pt_name_inst, OF at_name_inst])
qed
hence "((p::name prm) ∙ axP, p ∙ axQ) ∈ ?X" using B C
by auto
}
hence "eqvt ?X" by(simp add: eqvt_def)
from PSimQ have "(a<x>.P, a<x>.Q) ∈ ?X" by auto
thus ?thesis
proof(coinduct rule: weakBisimCoinduct)
case(cSim P Q)
thus ?case using ‹eqvt ?X›
by(force intro: inputPres)
next
case(cSym P Q)
thus ?case
by(blast dest: symmetric)
qed
qed
lemma outputPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
assumes "P ≈ Q"
shows "a{b}.(P) ≈ a{b}.(Q)"
proof -
let ?X = "{(a{b}.(P), a{b}.(Q)) | a b P Q. P ≈ Q}"
from assms have "(a{b}.(P), a{b}.(Q)) ∈ ?X" by auto
thus ?thesis
by(coinduct rule: weakBisimCoinduct)
(auto simp add: pi.inject intro: Weak_Late_Sim_Pres.outputPres symmetric)
qed
lemma resPres:
fixes P :: pi
and Q :: pi
and x :: name
assumes PBiSimQ: "P ≈ Q"
shows "<νx>P ≈ <νx>Q"
proof -
let ?X = "{x. ∃P Q. P ≈ Q ∧ (∃a. x = (<νa>P, <νa>Q))}"
from PBiSimQ have "(<νx>P, <νx>Q) ∈ ?X" by blast
moreover have "⋀P Q a. P ↝⇧^<weakBisim> Q ⟹ <νa>P ↝⇧^<(?X ∪ weakBisim)> <νa>Q"
proof -
fix P Q a
assume PSimQ: "P ↝⇧^<weakBisim> Q"
moreover have "⋀P Q a. P ≈ Q ⟹ (<νa>P, <νa>Q) ∈ ?X ∪ weakBisim" by blast
moreover have "weakBisim ⊆ ?X ∪ weakBisim" by blast
moreover have "eqvt weakBisim" by(rule eqvt)
moreover have "eqvt (?X ∪ weakBisim)"
by(auto simp add: eqvt_def dest: eqvtI)+
ultimately show "<νa>P ↝⇧^<(?X ∪ weakBisim)> <νa>Q"
by(rule Weak_Late_Sim_Pres.resPres)
qed
ultimately show ?thesis using PBiSimQ
by(coinduct rule: weakBisimCoinductAux, blast dest: unfoldE)
qed
lemma matchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
assumes "P ≈ Q"
shows "[a⌢b]P ≈ [a⌢b]Q"
proof -
let ?X = "{([a⌢b]P, [a⌢b]Q) | a b P Q. P ≈ Q}"
from assms have "([a⌢b]P, [a⌢b]Q) ∈ ?X" by auto
thus ?thesis
proof(coinduct rule: weakBisimCoinduct)
case(cSim P Q)
{
fix P Q a b
assume "P ≈ Q"
hence "P ↝⇧^<weakBisim> Q" by(rule unfoldE)
moreover {
fix P Q a
assume "P ≈ Q"
moreover have "[a⌢a]P ≈ P" by(rule matchId)
ultimately have "[a⌢a]P ≈ Q" by(blast intro: transitive)
}
moreover have "weakBisim ⊆ ?X ∪ weakBisim" by blast
ultimately have "[a⌢b]P ↝⇧^<(?X ∪ weakBisim)> [a⌢b]Q"
by(rule matchPres)
}
with ‹(P, Q) ∈ ?X› show ?case by auto
next
case(cSym P Q)
thus ?case by(auto simp add: pi.inject dest: symmetric)
qed
qed
lemma mismatchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
assumes "P ≈ Q"
shows "[a≠b]P ≈ [a≠b]Q"
proof -
let ?X = "{([a≠b]P, [a≠b]Q) | a b P Q. P ≈ Q}"
from assms have "([a≠b]P, [a≠b]Q) ∈ ?X" by auto
thus ?thesis
proof(coinduct rule: weakBisimCoinduct)
case(cSim P Q)
{
fix P Q a b
assume "P ≈ Q"
hence "P ↝⇧^<weakBisim> Q" by(rule unfoldE)
moreover {
fix P Q a b
assume "P ≈ Q" and "(a::name) ≠ b"
note ‹P ≈ Q›
moreover from ‹a ≠ b› have "[a≠b]P ≈ P" by(rule mismatchId)
ultimately have "[a≠b]P ≈ Q" by(blast intro: transitive)
}
moreover have "weakBisim ⊆ ?X ∪ weakBisim" by blast
ultimately have "[a≠b]P ↝⇧^<(?X ∪ weakBisim)> [a≠b]Q"
by(rule mismatchPres)
}
with ‹(P, Q) ∈ ?X› show ?case by auto
next
case(cSym P Q)
thus ?case by(auto simp add: pi.inject dest: symmetric)
qed
qed
lemma parPres:
fixes P :: pi
and Q :: pi
and R :: pi
assumes "P ≈ Q"
shows "P ∥ R ≈ Q ∥ R"
proof -
let ?ParSet = "{(resChain lst (P ∥ R), resChain lst (Q ∥ R)) | lst P Q R. P ≈ Q}"
have BC: "⋀P Q. P ∥ Q = resChain [] (P ∥ Q)" by auto
from assms have "(P ∥ R, Q ∥ R) ∈ ?ParSet" by(blast intro: BC)
thus ?thesis
proof(coinduct rule: weakBisimCoinduct)
case(cSim PR QR)
{
fix P Q R lst
assume "P ≈ Q"
from eqvtI have "eqvt (?ParSet ∪ weakBisim)"
by(auto simp add: eqvt_def, blast)
moreover have "⋀P Q a. (P, Q) ∈ ?ParSet ∪ weakBisim ⟹ (<νa>P, <νa>Q) ∈ ?ParSet ∪ weakBisim"
by(blast intro: resChain.step[THEN sym] resPres)
moreover {
from ‹P ≈ Q› have "P ↝⇧^<weakBisim> Q" by(rule unfoldE)
moreover note ‹P ≈ Q›
moreover {
fix P Q R
assume "P ≈ Q"
moreover have "P ∥ R = resChain [] (P ∥ R)" by simp
moreover have "Q ∥ R = resChain [] (Q ∥ R)" by simp
ultimately have "(P ∥ R, Q ∥ R) ∈ ?ParSet ∪ weakBisim" by blast
}
moreover {
fix P Q a
assume A: "(P, Q) ∈ ?ParSet ∪ weakBisim"
hence "(<νa>P, <νa>Q) ∈ ?ParSet ∪ weakBisim" (is "?goal")
apply(auto intro: resPres)
by(rule_tac x="a#lst" in exI) auto
}
ultimately have "(P ∥ R) ↝⇧^<(?ParSet ∪ weakBisim)> (Q ∥ R)" using eqvt ‹eqvt(?ParSet ∪ weakBisim)›
by(rule Weak_Late_Sim_Pres.parPres)
}
ultimately have "resChain lst (P ∥ R) ↝⇧^<(?ParSet ∪ weakBisim)> resChain lst (Q ∥ R)"
by(rule resChainI)
}
with ‹(PR, QR) ∈ ?ParSet› show ?case by blast
next
case(cSym PR QR)
thus ?case by(auto dest: symmetric)
qed
qed
lemma bangPres:
fixes P :: pi
and Q :: pi
assumes PBisimQ: "P ≈ Q"
shows "!P ≈ !Q"
proof -
let ?X = "(bangRel weakBisim)"
let ?Y = "Strong_Late_Bisim.bisim O (bangRel weakBisim) O Strong_Late_Bisim.bisim"
from eqvt Strong_Late_Bisim.bisimEqvt have eqvtY: "eqvt ?Y" by(blast intro: eqvtBangRel)
have XsubY: "?X ⊆ ?Y" by(auto intro: Strong_Late_Bisim.reflexive)
have RelStay: "⋀P Q. (P ∥ !P, Q) ∈ ?Y ⟹ (!P, Q) ∈ ?Y"
proof(auto)
fix P Q R T
assume PBisimQ: "P ∥ !P ∼ Q"
and QBRR: "(Q, R) ∈ bangRel weakBisim"
and RBisimT: "R ∼ T"
have "!P ∼ Q"
proof -
have "!P ∼ P ∥ !P" by(rule Strong_Late_Bisim_SC.bangSC)
thus ?thesis using PBisimQ by(rule Strong_Late_Bisim.transitive)
qed
with QBRR RBisimT show "(!P, T) ∈ ?Y" by blast
qed
have ParCompose: "⋀P Q R T. ⟦P ≈ Q; (R, T) ∈ ?Y⟧ ⟹ (P ∥ R, Q ∥ T) ∈ ?Y"
proof -
fix P Q R T
assume PBisimQ: "P ≈ Q"
and RYT: "(R, T) ∈ ?Y"
thus "(P ∥ R, Q ∥ T) ∈ ?Y"
proof(auto)
fix T' R'
assume T'BisimT: "T' ∼ T" and RBisimR': "R ∼ R'"
and R'BRT': "(R', T') ∈ bangRel weakBisim"
have "P ∥ R ∼ P ∥ R'"
proof -
from RBisimR' have "R ∥ P ∼ R' ∥ P" by(rule Strong_Late_Bisim_Pres.parPres)
moreover have "P ∥ R ∼ R ∥ P" and "R' ∥ P ∼ P ∥ R'" by(rule Strong_Late_Bisim_SC.parSym)+
ultimately show ?thesis by(blast intro: Strong_Late_Bisim.transitive)
qed
moreover from PBisimQ R'BRT' have "(P ∥ R', Q ∥ T') ∈ bangRel weakBisim" by(rule BRPar)
moreover have "Q ∥ T' ∼ Q ∥ T"
proof -
from T'BisimT have "T' ∥ Q ∼ T ∥ Q" by(rule Strong_Late_Bisim_Pres.parPres)
moreover have "Q ∥ T' ∼ T' ∥ Q" and "T ∥ Q ∼ Q ∥ T" by(rule Strong_Late_Bisim_SC.parSym)+
ultimately show ?thesis by(blast intro: Strong_Late_Bisim.transitive)
qed
ultimately show ?thesis by blast
qed
qed
have ResCong: "⋀P Q x. (P, Q) ∈ ?Y ⟹ (<νx>P, <νx>Q) ∈ ?Y"
by(auto intro: BRRes Strong_Late_Bisim_Pres.resPres transitive)
from PBisimQ have "(!P, !Q) ∈ ?X" by(rule BRBang)
moreover from eqvt have "eqvt (bangRel weakBisim)" by(rule eqvtBangRel)
ultimately show ?thesis
proof(coinduct rule: weakBisimTransitiveCoinduct)
case(cSim P Q)
from ‹(P, Q) ∈ ?X›
show "P ↝⇧^<?Y> Q"
proof(induct)
case(BRBang P Q)
have "P ≈ Q" by fact
moreover hence "P ↝⇧^<weakBisim> Q" by(blast dest: unfoldE)
moreover have "⋀P Q. P ≈ Q ⟹ P ↝⇧^<weakBisim> Q" by(blast dest: unfoldE)
moreover from Strong_Late_Bisim.bisimEqvt eqvt have "eqvt ?Y" by(blast intro: eqvtBangRel)
ultimately show "!P ↝⇧^<?Y> !Q" using ParCompose ResCong RelStay XsubY
by(rule_tac Weak_Late_Sim_Pres.bangPres, simp_all)
next
case(BRPar P Q R T)
have PBiSimQ: "P ≈ Q" by fact
have RBangRelT: "(R, T) ∈ ?X" by fact
have RSimT: "R ↝⇧^<?Y> T" by fact
moreover from PBiSimQ have "P ↝⇧^<weakBisim> Q" by(blast dest: unfoldE)
moreover from RBangRelT have "(R, T) ∈ ?Y" by(blast intro: Strong_Late_Bisim.reflexive)
ultimately show "P ∥ R ↝⇧^<?Y> Q ∥ T" using ParCompose ResCong eqvt eqvtY ‹P ≈ Q›
by(rule_tac Weak_Late_Sim_Pres.parCompose)
next
case(BRRes P Q x)
have "P ↝⇧^<?Y> Q" by fact
thus "<νx>P ↝⇧^<?Y> <νx>Q" using ResCong eqvtY XsubY
by(rule_tac Weak_Late_Sim_Pres.resPres, simp_all)
qed
next
case(cSym P Q)
thus ?case by(metis symmetric bangRelSymetric)
qed
qed
end
Theory Weak_Late_Cong_Pres
theory Weak_Late_Cong_Pres
imports Weak_Late_Cong Weak_Late_Step_Sim_Pres Weak_Late_Bisim_Pres
begin
lemma tauPres:
fixes P :: pi
and Q :: pi
assumes "P ≃ Q"
shows "τ.(P) ≃ τ.(Q)"
using assms
by(blast intro: unfoldI Weak_Late_Step_Sim_Pres.tauPres dest: congruenceWeakBisim symetric)
lemma outputPres:
fixes P :: pi
and Q :: pi
assumes "P ≃ Q"
shows "a{b}.P ≃ a{b}.Q"
using assms
by(blast intro: unfoldI Weak_Late_Step_Sim_Pres.outputPres dest: congruenceWeakBisim symetric)
lemma inputPres:
fixes P :: pi
and Q :: pi
and a :: name
and x :: name
assumes PSimQ: "∀y. P[x::=y] ≃ Q[x::=y]"
shows "a<x>.P ≃ a<x>.Q"
using assms
apply(rule_tac unfoldI)
apply(rule_tac Weak_Late_Step_Sim_Pres.inputPres, auto intro: congruenceWeakBisim)
by(rule_tac Weak_Late_Step_Sim_Pres.inputPres, auto intro: congruenceWeakBisim Weak_Late_Bisim.symmetric)
lemma matchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
assumes "P ≃ Q"
shows "[a⌢b]P ≃ [a⌢b]Q"
using assms
by(blast intro: unfoldI Weak_Late_Step_Sim_Pres.matchPres dest: unfoldE symetric)
lemma mismatchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
assumes "P ≃ Q"
shows "[a≠b]P ≃ [a≠b]Q"
using assms
by(blast intro: unfoldI Weak_Late_Step_Sim_Pres.mismatchPres dest: unfoldE symetric)
lemma sumPres:
fixes P :: pi
and Q :: pi
and R :: pi
assumes "P ≃ Q"
shows "P ⊕ R ≃ Q ⊕ R"
using assms
by(blast intro: Weak_Late_Bisim.reflexive unfoldI Weak_Late_Step_Sim_Pres.sumPres dest: unfoldE symetric)
lemma parPres:
fixes P :: pi
and Q :: pi
and R :: pi
assumes "P ≃ Q"
shows "P ∥ R ≃ Q ∥ R"
proof -
have "⋀P Q R. ⟦P ↝<weakBisim> Q; P ≈ Q⟧ ⟹ P ∥ R ↝<weakBisim> Q ∥ R"
proof -
fix P Q R
assume "P ↝<weakBisim> Q" and "P ≈ Q"
thus "P ∥ R ↝<weakBisim> Q ∥ R"
using Weak_Late_Bisim_Pres.parPres Weak_Late_Bisim_Pres.resPres Weak_Late_Bisim.reflexive Weak_Late_Bisim.eqvt
by(blast intro: Weak_Late_Step_Sim_Pres.parPres)
qed
with assms show ?thesis
by(blast intro: unfoldI dest: congruenceWeakBisim unfoldE symetric)
qed
lemma resPres:
fixes P :: pi
and Q :: pi
and x :: name
assumes PeqQ: "P ≃ Q"
shows "<νx>P ≃ <νx>Q"
proof -
have "⋀P Q x. P ↝<weakBisim> Q ⟹ <νx>P ↝<weakBisim> <νx>Q"
proof -
fix P Q x
assume "P ↝<weakBisim> Q"
with Weak_Late_Bisim.eqvt Weak_Late_Bisim_Pres.resPres show "<νx>P ↝<weakBisim> <νx>Q"
by(blast intro: Weak_Late_Step_Sim_Pres.resPres)
qed
with assms show ?thesis
by(blast intro: unfoldI dest: congruenceWeakBisim unfoldE symetric)
qed
lemma congruenceBang:
fixes P :: pi
and Q :: pi
assumes "P ≃ Q"
shows "!P ≃ !Q"
proof -
have "⋀P Q. ⟦P ↝<weakBisim> Q; P ≃ Q⟧ ⟹ !P ↝<weakBisim> !Q"
proof -
fix P Q
assume "P ↝<weakBisim> Q" and "P ≃ Q"
hence "!P ↝<bangRel weakBisim> !Q" using unfoldE(1) congruenceWeakBisim Weak_Late_Bisim.eqvt
by(rule Weak_Late_Step_Sim_Pres.bangPres)
moreover have "bangRel weakBisim ⊆ weakBisim"
proof auto
fix a b
assume "(a, b) ∈ bangRel weakBisim"
thus "a ≈ b"
apply(induct rule: bangRel.induct)
apply (metis Weak_Late_Bisim_Pres.bangPres)
apply (metis Weak_Late_Bisim.reflexive Weak_Late_Bisim.symmetric Weak_Late_Bisim.transitive Weak_Late_Bisim_Pres.parPres Weak_Late_Bisim_SC.parSym)
by (metis Weak_Late_Bisim_Pres.resPres)
qed
ultimately show"!P ↝<weakBisim> !Q"
by(rule Weak_Late_Step_Sim.monotonic)
qed
with assms show ?thesis
by(blast intro: unfoldI dest: unfoldE symetric congruenceWeakBisim)
qed
end
Theory Early_Semantics
theory Early_Semantics
imports Agent
begin
declare name_fresh[simp del]
nominal_datatype freeRes = InputR name name ("_<_>" [110, 110] 110)
| OutputR name name ("_[_]" [110, 110] 110)
| TauR ("τ" 110)
nominal_datatype residual = BoundOutputR name "«name» pi" ("_<ν_> ≺ _" [110, 110, 110] 110)
| FreeR freeRes pi
lemma alphaBoundOutput:
fixes a :: name
and x :: name
and P :: pi
and x' :: name
assumes A1: "x' ♯ P"
shows "a<νx> ≺ P = a<νx'> ≺ ([(x, x')] ∙ P)"
proof(cases "x=x'")
assume "x=x'"
thus ?thesis by simp
next
assume "x ≠ x'"
with A1 show ?thesis
by(simp add: residual.inject alpha name_fresh_left name_calc)
qed
declare name_fresh[simp]
abbreviation Transitions_Freejudge ("_ ≺ _" [80, 80] 80) where "α ≺ P' ≡ (FreeR α P')"
inductive "TransitionsEarly" :: "pi ⇒ residual ⇒ bool" ("_ ⟼ _" [80, 80] 80)
where
Tau: "τ.(P) ⟼ τ ≺ P"
| Input: "⟦x ≠ a; x ≠ u⟧ ⟹ a<x>.P ⟼ a<u> ≺ (P[x::=u])"
| Output: "a{b}.P ⟼ a[b] ≺ P"
| Match: "⟦P ⟼ V⟧ ⟹ [b⌢b]P ⟼ V"
| Mismatch: "⟦P ⟼ V; a ≠ b⟧ ⟹ [a≠b]P ⟼ V"
| Open: "⟦P ⟼ a[b] ≺ P'; a ≠ b⟧ ⟹ <νb>P ⟼ a<νb> ≺ P'"
| Sum1: "⟦P ⟼ V⟧ ⟹ (P ⊕ Q) ⟼ V"
| Sum2: "⟦Q ⟼ V⟧ ⟹ (P ⊕ Q) ⟼ V"
| Par1B: "⟦P ⟼ a<νx> ≺ P'; x ♯ P; x ♯ Q; x ≠ a⟧ ⟹ P ∥ Q ⟼ a<νx> ≺ (P' ∥ Q)"
| Par1F: "⟦P ⟼ α ≺ P'⟧ ⟹ P ∥ Q ⟼ α ≺ (P' ∥ Q)"
| Par2B: "⟦Q ⟼ a<νx> ≺ Q'; x ♯ P; x ♯ Q; x ≠ a⟧ ⟹ P ∥ Q ⟼ a<νx> ≺ (P ∥ Q')"
| Par2F: "⟦Q ⟼ α ≺ Q'⟧ ⟹ P ∥ Q ⟼ α ≺ (P ∥ Q')"
| Comm1: "⟦P ⟼ a<b> ≺ P'; Q ⟼ a[b] ≺ Q'⟧ ⟹ P ∥ Q ⟼ τ ≺ P' ∥ Q'"
| Comm2: "⟦P ⟼ a[b] ≺ P'; Q ⟼ a<b> ≺ Q'⟧ ⟹ P ∥ Q ⟼ τ ≺ P' ∥ Q'"
| Close1: "⟦P ⟼ a<x> ≺ P'; Q ⟼ a<νx> ≺ Q'; x ♯ P; x ♯ Q; x ≠ a⟧ ⟹ P ∥ Q ⟼ τ ≺ <νx>(P' ∥ Q')"
| Close2: "⟦P ⟼ a<νx> ≺ P'; Q ⟼ a<x> ≺ Q'; x ♯ P; x ♯ Q; x ≠ a⟧ ⟹ P ∥ Q ⟼ τ ≺ <νx>(P' ∥ Q')"
| ResB: "⟦P ⟼ a<νx> ≺ P'; y ≠ a; y ≠ x; x ♯ P; x ≠ a⟧ ⟹ <νy>P ⟼ a<νx> ≺ (<νy>P')"
| ResF: "⟦P ⟼ α ≺ P'; y ♯ α⟧ ⟹ <νy>P ⟼ α ≺ <νy>P'"
| Bang: "⟦P ∥ !P ⟼ V⟧ ⟹ !P ⟼ V"
equivariance TransitionsEarly
nominal_inductive TransitionsEarly
by(auto simp add: abs_fresh fresh_fact2)
lemmas [simp] = freeRes.inject
lemma freshOutputAction:
fixes P :: pi
and a :: name
and b :: name
and P' :: pi
and c :: name
assumes "P ⟼ a[b] ≺ P'"
and "c ♯ P"
shows "c ≠ a" and "c ≠ b" and "c ♯ P'"
proof -
from assms have "c ≠ a ∧ c ≠ b ∧ c ♯ P'"
by(nominal_induct x2=="a[b] ≺ P'" arbitrary: P' rule: TransitionsEarly.strong_induct) (fastforce simp add: residual.inject abs_fresh freeRes.inject)+
thus "c ≠ a" and "c ≠ b" and "c ♯ P'"
by blast+
qed
lemma freshInputAction:
fixes P :: pi
and a :: name
and b :: name
and P' :: pi
and c :: name
assumes "P ⟼ a<b> ≺ P'"
and "c ♯ P"
shows "c ≠ a"
using assms
by(nominal_induct x2=="a<b> ≺ P'" arbitrary: P' rule: TransitionsEarly.strong_induct) (auto simp add: residual.inject abs_fresh)
lemma freshBoundOutputAction:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
and c :: name
assumes "P ⟼ a<νx> ≺ P'"
and "c ♯ P"
shows "c ≠ a"
using assms
by(nominal_induct x2=="a<νx> ≺ P'" avoiding: x arbitrary: P' rule: TransitionsEarly.strong_induct) (auto simp add: residual.inject abs_fresh fresh_left calc_atm dest: freshOutputAction)
lemmas freshAction = freshOutputAction freshInputAction freshBoundOutputAction
lemma freshInputTransition:
fixes P :: pi
and a :: name
and u :: name
and P' :: pi
and c :: name
assumes "P ⟼ a<u> ≺ P'"
and "c ♯ P"
and "c ≠ u"
shows "c ♯ P'"
using assms
by(nominal_induct x2=="a<u> ≺ P'" arbitrary: P' rule: TransitionsEarly.strong_induct)
(fastforce simp add: residual.inject name_fresh_abs fresh_fact1 fresh_fact2)+
lemma freshBoundOutputTransition:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
and c :: name
assumes "P ⟼ a<νx> ≺ P'"
and "c ♯ P"
and "c ≠ x"
shows "c ♯ P'"
using assms
apply(nominal_induct x2=="a<νx> ≺ P'" avoiding: x arbitrary: P' rule: TransitionsEarly.strong_induct)
apply(fastforce simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction | simp | auto simp add: abs_fresh residual.inject alpha' calc_atm)
apply(fastforce simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction | simp | auto simp add: abs_fresh residual.inject alpha' calc_atm)
apply(fastforce simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction | simp | auto simp add: abs_fresh residual.inject alpha' calc_atm)
apply(force simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction | simp | auto simp add: abs_fresh residual.inject alpha' calc_atm)
apply(force simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction | simp | auto simp add: abs_fresh residual.inject alpha' calc_atm)
apply(force simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction | simp | auto simp add: abs_fresh residual.inject alpha' calc_atm)
apply(force simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction | simp | auto simp add: abs_fresh residual.inject alpha' calc_atm)
apply(force simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction | simp | auto simp add: abs_fresh residual.inject alpha' calc_atm)
apply(force simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction | simp | auto simp add: abs_fresh residual.inject alpha' calc_atm)
apply(force simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction | simp | auto simp add: abs_fresh residual.inject alpha' calc_atm)
apply(force simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction | simp | auto simp add: abs_fresh residual.inject alpha' calc_atm)
apply(force simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction | simp | auto simp add: abs_fresh residual.inject alpha' calc_atm)
apply(fastforce simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction)
apply(fastforce simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction)
apply(fastforce simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction)
apply(fastforce simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction)
apply(auto simp add: residual.inject name_fresh_abs alpha' fresh_left calc_atm dest: freshOutputAction)
done
lemma freshTauTransition:
fixes P :: pi
and P' :: pi
and c :: name
assumes "P ⟼ τ ≺ P'"
and "c ♯ P"
shows "c ♯ P'"
using assms
apply(nominal_induct x2=="τ ≺ P'" arbitrary: P' rule: TransitionsEarly.strong_induct)
by(fastforce simp add: residual.inject abs_fresh dest: freshOutputAction freshInputTransition freshBoundOutputTransition)+
lemma freshFreeTransition:
fixes P :: pi
and α :: freeRes
and P' :: pi
and c :: name
assumes "P ⟼α ≺ P'"
and "c ♯ P"
and "c ♯ α"
shows "c ♯ P'"
using assms
by(nominal_induct α rule: freeRes.strong_inducts)
(auto dest: freshInputTransition freshOutputAction freshTauTransition)
lemmas freshTransition = freshInputTransition freshOutputAction freshFreeTransition
freshBoundOutputTransition freshTauTransition
lemma substTrans[simp]: "b ♯ P ⟹ ((P::pi)[a::=b])[b::=c] = P[a::=c]"
apply(simp add: injPermSubst[THEN sym])
apply(simp add: renaming)
by(simp add: pt_swap[OF pt_name_inst, OF at_name_inst])
lemma Input:
fixes a :: name
and x :: name
and u :: name
and P :: pi
shows "a<x>.P ⟼a<u> ≺ P[x::=u]"
proof -
obtain y::name where "y ≠ a" and "y ≠ u" and "y ♯ P"
by(generate_fresh "name") (auto simp add: fresh_prod)
from ‹y ≠ a› ‹y ≠ u› have "a<y>.([(x, y)] ∙ P) ⟼a<u> ≺ ([(x, y)] ∙ P)[y::=u]"
by(rule Input)
with ‹y ♯ P› show ?thesis by(simp add: alphaInput renaming name_swap)
qed
lemma Par1B:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
and Q :: pi
assumes "P ⟼a<νx> ≺ P'"
and "x ♯ Q"
shows "P ∥ Q ⟼ a<νx> ≺ (P' ∥ Q)"
proof -
obtain y::name where "y ♯ P" and "y ♯ Q" and "y ≠ a" and "y ♯ P'"
by(generate_fresh "name") (auto simp add: fresh_prod)
from ‹P ⟼a<νx> ≺ P'› ‹y ♯ P'› have "P ⟼a<νy> ≺ ([(x, y)] ∙ P')"
by(simp add: alphaBoundOutput)
hence "P ∥ Q ⟼a<νy> ≺ (([(x, y)] ∙ P') ∥ Q)" using ‹y ♯ P› ‹y ♯ Q› ‹y ≠ a›
by(rule Par1B)
with ‹x ♯ Q› ‹y ♯ Q› ‹y ♯ P'› show ?thesis
by(subst alphaBoundOutput) (auto simp add: name_fresh_fresh)
qed
lemma Par2B:
fixes Q :: pi
and a :: name
and x :: name
and Q' :: pi
and P :: pi
assumes "Q ⟼a<νx> ≺ Q'"
and "x ♯ P"
shows "P ∥ Q ⟼ a<νx> ≺ (P ∥ Q')"
proof -
obtain y::name where "y ♯ P" and "y ♯ Q" and "y ≠ a" and "y ♯ Q'"
by(generate_fresh "name") (auto simp add: fresh_prod)
from ‹Q ⟼a<νx> ≺ Q'› ‹y ♯ Q'› have "Q ⟼a<νy> ≺ ([(x, y)] ∙ Q')"
by(simp add: alphaBoundOutput)
hence "P ∥ Q ⟼a<νy> ≺ (P ∥ ([(x, y)] ∙ Q'))" using ‹y ♯ P› ‹y ♯ Q› ‹y ≠ a›
by(rule Par2B)
with ‹x ♯ P› ‹y ♯ P› ‹y ♯ Q'› show ?thesis
by(subst alphaBoundOutput[of y]) (auto simp add: name_fresh_fresh)
qed
lemma inputInduct[consumes 1, case_names cInput cMatch cMismatch cSum1 cSum2 cPar1 cPar2 cRes cBang]:
fixes P :: pi
and a :: name
and u :: name
and P' :: pi
and F :: "'a::fs_name ⇒ pi ⇒ name ⇒ name ⇒ pi ⇒ bool"
and C :: "'a::fs_name"
assumes Trans: "P ⟼a<u> ≺ P'"
and "⋀a x P u C. ⟦x ♯ C; x ≠ u; x ≠ a⟧ ⟹ F C (a<x>.P) a u (P[x::=u])"
and "⋀P a u P' b C. ⟦P ⟼a<u> ≺ P'; ⋀C. F C P a u P'⟧ ⟹ F C ([b⌢b]P) a u P'"
and "⋀P a u P' b c C. ⟦P ⟼a<u> ≺ P'; ⋀C. F C P a u P'; b≠c⟧ ⟹ F C ([b≠c]P) a u P'"
and "⋀P a u P' Q C. ⟦P ⟼a<u> ≺ P'; ⋀C. F C P a u P'⟧ ⟹ F C (P ⊕ Q) a u P'"
and "⋀Q a u Q' P C. ⟦Q ⟼a<u> ≺ Q'; ⋀C. F C Q a u Q'⟧ ⟹ F C (P ⊕ Q) a u Q'"
and "⋀P a u P' Q C. ⟦P ⟼a<u> ≺ P'; ⋀C. F C P a u P'⟧ ⟹ F C (P ∥ Q) a u (P' ∥ Q)"
and "⋀Q a u Q' P C. ⟦Q ⟼a<u> ≺ Q'; ⋀C. F C Q a u Q'⟧ ⟹ F C (P ∥ Q) a u (P ∥ Q')"
and "⋀P a u P' x C. ⟦P ⟼a<u> ≺ P'; x ≠ a; x ≠ u; x ♯ C; ⋀C. F C P a u P'⟧ ⟹ F C (<νx>P) a u (<νx>P')"
and "⋀P a u P' C. ⟦P ∥ !P ⟼a<u> ≺ P'; ⋀C. F C (P ∥ !P) a u P'⟧ ⟹ F C (!P) a u P'"
shows "F C P a u P'"
using assms
by(nominal_induct x2=="a<u> ≺ P'" avoiding: C arbitrary: P' rule: TransitionsEarly.strong_induct)
(auto simp add: residual.inject)
lemma inputAlpha:
assumes "P ⟼a<u> ≺ P'"
and "u ♯ P"
and "r ♯ P'"
shows "P ⟼a<r> ≺ ([(u, r)] ∙ P')"
using assms
proof(nominal_induct avoiding: r rule: inputInduct)
case(cInput a x P u r)
from ‹x ≠ u› ‹u ♯ a<x>.P›have "u ≠ a" and "u ♯ P" by(simp add: abs_fresh)+
have "a<x>.P ⟼a<r> ≺ P[x::=r]"
by(rule Input)
thus ?case using ‹r ♯ P[x::=u]› ‹u ♯ P›
by(simp add: injPermSubst substTrans)
next
case(cMatch P a u P' b r)
thus ?case by(force intro: Match)
next
case(cMismatch P a u P' b c r)
thus ?case by(force intro: Mismatch)
next
case(cSum1 P a u P' Q r)
thus ?case by(force intro: Sum1)
next
case(cSum2 Q a u Q' P r)
thus ?case by(force intro: Sum2)
next
case(cPar1 P a u P' Q r)
thus ?case by(force intro: Par1F simp add: eqvts name_fresh_fresh)
next
case(cPar2 Q a u Q' P r)
thus ?case by(force intro: Par2F simp add: eqvts name_fresh_fresh)
next
case(cRes P a u P' x r)
thus ?case by(force intro: ResF simp add: eqvts calc_atm abs_fresh)
next
case(cBang P a u P' R)
thus ?case by(force intro: Bang)
qed
lemma Close1:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
and Q :: pi
and Q' :: pi
assumes "P ⟼a<x> ≺ P'"
and "Q ⟼a<νx> ≺ Q'"
and "x ♯ P"
shows "P ∥ Q ⟼τ ≺ <νx>(P' ∥ Q')"
proof -
obtain y::name where "y ♯ P" and "y ♯ Q" and "y ≠ a" and "y ♯ Q'" and "y ♯ P'"
by(generate_fresh "name") (auto simp add: fresh_prod)
from ‹P ⟼a<x> ≺ P'› ‹x ♯ P› ‹y ♯ P'› have "P ⟼a<y> ≺ ([(x, y)] ∙ P')"
by(rule inputAlpha)
moreover from ‹Q ⟼a<νx> ≺ Q'› ‹y ♯ Q'› have "Q ⟼a<νy> ≺ ([(x, y)] ∙ Q')"
by(simp add: alphaBoundOutput)
ultimately have "P ∥ Q ⟼τ ≺ <νy>(([(x, y)] ∙ P') ∥ ([(x, y)] ∙ Q'))" using ‹y ♯ P› ‹y ♯ Q› ‹y ≠ a›
by(rule Close1)
with ‹y ♯ P'› ‹y ♯ Q'› show ?thesis by(subst alphaRes) (auto simp add: name_fresh_fresh)
qed
lemma Close2:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
and Q :: pi
and Q' :: pi
assumes "P ⟼a<νx> ≺ P'"
and "Q ⟼a<x> ≺ Q'"
and "x ♯ Q"
shows "P ∥ Q ⟼τ ≺ <νx>(P' ∥ Q')"
proof -
obtain y::name where "y ♯ P" and "y ♯ Q" and "y ≠ a" and "y ♯ Q'" and "y ♯ P'"
by(generate_fresh "name") (auto simp add: fresh_prod)
from ‹P ⟼a<νx> ≺ P'› ‹y ♯ P'› have "P ⟼a<νy> ≺ ([(x, y)] ∙ P')"
by(simp add: alphaBoundOutput)
moreover from ‹Q ⟼a<x> ≺ Q'› ‹x ♯ Q› ‹y ♯ Q'› have "Q ⟼a<y> ≺ ([(x, y)] ∙ Q')"
by(rule inputAlpha)
ultimately have "P ∥ Q ⟼τ ≺ <νy>(([(x, y)] ∙ P') ∥ ([(x, y)] ∙ Q'))" using ‹y ♯ P› ‹y ♯ Q› ‹y ≠ a›
by(rule Close2)
with ‹y ♯ P'› ‹y ♯ Q'› show ?thesis by(subst alphaRes) (auto simp add: name_fresh_fresh)
qed
lemma ResB:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
and y :: name
assumes "P ⟼a<νx> ≺ P'"
and "y ≠ a"
and "y ≠ x"
shows "<νy>P ⟼a<νx> ≺ (<νy>P')"
proof -
obtain z :: name where "z ♯ P" and "z ♯ P'" and "z ≠ a" and "z ≠ y"
by(generate_fresh "name") (auto simp add: fresh_prod)
from ‹P ⟼a<νx> ≺ P'› ‹z ♯ P'› have "P ⟼a<νz> ≺ ([(x, z)] ∙ P')"
by(simp add: alphaBoundOutput)
hence "<νy>P ⟼a<νz> ≺ (<νy>([(x, z)] ∙ P'))" using ‹y ≠ a› ‹z ≠ y› ‹z ♯ P› ‹z ≠ a›
by(rule_tac ResB) auto
thus ?thesis using ‹z ≠ y› ‹y ≠ x› ‹z ♯ P'›
by(subst alphaBoundOutput[where x'=z]) (auto simp add: eqvts calc_atm abs_fresh)
qed
lemma outputInduct[consumes 1, case_names Output Match Mismatch Sum1 Sum2 Par1 Par2 Res Bang]:
fixes P :: pi
and a :: name
and b :: name
and P' :: pi
and F :: "'a::fs_name ⇒ pi ⇒ name ⇒ name ⇒ pi ⇒ bool"
and C :: "'a::fs_name"
assumes Trans: "P ⟼a[b] ≺ P'"
and "⋀a b P C. F C (a{b}.P) a b P"
and "⋀P a b P' c C. ⟦P ⟼OutputR a b ≺ P'; ⋀C. F C P a b P'⟧ ⟹ F C ([c⌢c]P) a b P'"
and "⋀P a b P' c d C. ⟦P ⟼OutputR a b ≺ P'; ⋀C. F C P a b P'; c≠d⟧ ⟹ F C ([c≠d]P) a b P'"
and "⋀P a b P' Q C. ⟦P ⟼OutputR a b ≺ P'; ⋀C. F C P a b P'⟧ ⟹ F C (P ⊕ Q) a b P'"
and "⋀Q a b Q' P C. ⟦Q ⟼OutputR a b ≺ Q'; ⋀C. F C Q a b Q'⟧ ⟹ F C (P ⊕ Q) a b Q'"
and "⋀P a b P' Q C. ⟦P ⟼OutputR a b ≺ P'; ⋀C. F C P a b P'⟧ ⟹ F C (P ∥ Q) a b (P' ∥ Q)"
and "⋀Q a b Q' P C. ⟦Q ⟼OutputR a b ≺ Q'; ⋀C. F C Q a b Q'⟧ ⟹ F C (P ∥ Q) a b (P ∥ Q')"
and "⋀P a b P' x C. ⟦P ⟼OutputR a b ≺ P'; x ≠ a; x ≠ b; x ♯ C; ⋀C. F C P a b P'⟧ ⟹
F C (<νx>P) a b (<νx>P')"
and "⋀P a b P' C. ⟦P ∥ !P ⟼OutputR a b ≺ P'; ⋀C. F C (P ∥ !P) a b P'⟧ ⟹ F C (!P) a b P'"
shows "F C P a b P'"
using assms
by(nominal_induct x2=="a[b] ≺ P'" avoiding: C arbitrary: P' rule: TransitionsEarly.strong_induct)
(auto simp add: residual.inject)
lemma boundOutputInduct[consumes 2, case_names Match Mismatch Open Sum1 Sum2 Par1 Par2 Res Bang]:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
and F :: "('a::fs_name) ⇒ pi ⇒ name ⇒ name ⇒ pi ⇒ bool"
and C :: "'a::fs_name"
assumes a: "P ⟼a<νx> ≺ P'"
and xFreshP: "x ♯ P"
and cMatch: "⋀P a x P' b C. ⟦P ⟼a<νx> ≺ P'; ⋀C. F C P a x P'⟧ ⟹ F C ([b⌢b]P) a x P'"
and cMismatch: "⋀P a x P' b c C. ⟦P ⟼a<νx> ≺ P'; ⋀C. F C P a x P'; b ≠ c⟧ ⟹ F C ([b≠c]P) a x P'"
and cOpen: "⋀P a x P' C. ⟦P ⟼(OutputR a x) ≺ P'; a ≠ x⟧ ⟹ F C (<νx>P) a x P'"
and cSum1: "⋀P Q a x P' C. ⟦P ⟼a<νx> ≺ P'; ⋀C. F C P a x P'⟧ ⟹ F C (P ⊕ Q) a x P'"
and cSum2: "⋀P Q a x Q' C. ⟦Q ⟼a<νx> ≺ Q'; ⋀C. F C Q a x Q'⟧ ⟹ F C (P ⊕ Q) a x Q'"
and cPar1B: "⋀P P' Q a x C. ⟦P ⟼a<νx> ≺ P'; x ♯ Q; ⋀C. F C P a x P'⟧ ⟹
F C (P ∥ Q) a x (P' ∥ Q)"
and cPar2B: "⋀P Q Q' a x C. ⟦Q ⟼a<νx> ≺ Q'; x ♯ P; ⋀C. F C Q a x Q'⟧ ⟹
F C (P ∥ Q) a x (P ∥ Q')"
and cResB: "⋀P P' a x y C. ⟦P ⟼a<νx> ≺ P'; y ≠ a; y ≠ x; y ♯ C;
⋀C. F C P a x P'⟧ ⟹ F C (<νy>P) a x (<νy>P')"
and cBang: "⋀P a x P' C. ⟦P ∥ !P ⟼a<νx> ≺ P'; ⋀C. F C (P ∥ !P) a x P'⟧ ⟹
F C (!P) a x P'"
shows "F C P a x P'"
using assms
proof -
have Goal: "⋀P Rs a x P' C. ⟦P ⟼ Rs; Rs = a<νx> ≺ P'; x ♯ P⟧ ⟹ F C P a x P'"
proof -
fix P Rs a x P' C
assume "P ⟼ Rs" and "Rs = a<νx> ≺ P'" and "x ♯ P"
thus "F C P a x P'"
proof(nominal_induct avoiding: C a x P' rule: TransitionsEarly.strong_induct)
case(Tau P)
thus ?case by(simp add: residual.inject)
next
case(Input P a x)
thus ?case by(simp add: residual.inject)
next
case(Output P a b)
thus ?case by(simp add: residual.inject)
next
case(Match P Rs b C a x P')
thus ?case
by(force intro: cMatch simp add: residual.inject)
next
case(Mismatch P Rs b c C a x P')
thus ?case
by(force intro: cMismatch simp add: residual.inject)
next
case(Sum1 P Q Rs C)
thus ?case by(force intro: cSum1)
next
case(Sum2 P Q Rs C)
thus ?case by(force intro: cSum2)
next
case(Open P a b P' C a' x P'')
have "b ♯ x" by fact hence bineqx: "b ≠ x" by simp
moreover have "a<νb> ≺ P' = a'<νx> ≺ P''" by fact
ultimately have aeqa': "a=a'" and P'eqP'': "P'' = [(b, x)] ∙ P'"
by(simp add: residual.inject name_abs_eq)+
have "x ♯ <νb>P" by fact
with bineqx have xFreshP: "x ♯ P" by(simp add: name_fresh_abs)
have aineqb: "a ≠ b" by fact
have PTrans: "P ⟼a[b] ≺ P'" by fact
with xFreshP have xineqa: "x ≠ a" by(force dest: freshAction)
from PTrans have "([(b, x)] ∙ P) ⟼[(b, x)] ∙ (a[b] ≺ P')" by(rule TransitionsEarly.eqvt)
with P'eqP'' xineqa aineqb have Trans: "([(b, x)] ∙ P) ⟼a[x] ≺ P''"
by(auto simp add: name_calc)
hence "F C (<νx>([(b, x)] ∙ P)) a x P''" using xineqa by(blast intro: cOpen)
with xFreshP aeqa' show ?case by(simp add: alphaRes)
next
case(Par1B P a x P' Q C a' x' P'')
have "x ♯ x'" by fact hence xineqx': "x ≠ x'" by simp
moreover have Eq: "a<νx> ≺ (P' ∥ Q) = a'<νx'> ≺ P''" by fact
hence aeqa': "a = a'" by(simp add: residual.inject)
have xFreshQ: "x ♯ Q" by fact
have "x' ♯ P ∥ Q" by fact
hence x'FreshP: "x' ♯ P" and x'FreshQ: "x' ♯ Q" by simp+
have P''eq: "P'' = ([(x, x')] ∙ P') ∥ Q"
proof -
from Eq xineqx' have "(P' ∥ Q) = [(x, x')] ∙ P''"
by(simp add: residual.inject name_abs_eq)
hence "([(x, x')] ∙ (P' ∥ Q)) = P''" by simp
with x'FreshQ xFreshQ show ?thesis by(simp add: name_fresh_fresh)
qed
have "x ♯ P''" by fact
with P''eq have x'FreshP': "x' ♯ P'" by(simp add: name_fresh_left name_calc)
have "P ⟼a<νx> ≺ P'" by fact
with x'FreshP' aeqa' have "P ⟼a'<νx'> ≺ ([(x, x')] ∙ P')"
by(simp add: alphaBoundOutput)
moreover have "⋀C. F C P a x' ([(x, x')] ∙ P')"
proof -
fix C
have "⋀C a' x' P''. ⟦a<νx> ≺ P' = a'<νx'> ≺ P''; x' ♯ P⟧ ⟹ F C P a' x' P''" by fact
moreover with aeqa' xineqx' x'FreshP' have "a<νx> ≺ P' = a'<νx'> ≺ ([(x, x')] ∙ P')"
by(simp add: residual.inject name_abs_eq name_fresh_left name_calc)
ultimately show "F C P a x' ([(x, x')] ∙ P')" using x'FreshP aeqa' by blast
qed
ultimately have "F C (P ∥ Q) a' x' (([(x, x')] ∙ P') ∥ Q)" using x'FreshQ aeqa'
by(blast intro: cPar1B)
with P''eq show ?case by simp
next
case(Par1F P P' Q α)
thus ?case by(simp add: residual.inject)
next
case(Par2B Q a x Q' P C a' x' Q'')
have "x ♯ x'" by fact hence xineqx': "x ≠ x'" by simp
moreover have Eq: "a<νx> ≺ (P ∥ Q') = a'<νx'> ≺ Q''" by fact
hence aeqa': "a = a'" by(simp add: residual.inject)
have xFreshP: "x ♯ P" by fact
have "x' ♯ P ∥ Q" by fact
hence x'FreshP: "x' ♯ P" and x'FreshQ: "x' ♯ Q" by simp+
have Q''eq: "Q'' = P ∥ ([(x, x')] ∙ Q')"
proof -
from Eq xineqx' have "(P ∥ Q') = [(x, x')] ∙ Q''"
by(simp add: residual.inject name_abs_eq)
hence "([(x, x')] ∙ (P ∥ Q')) = Q''" by simp
with x'FreshP xFreshP show ?thesis by(simp add: name_fresh_fresh)
qed
have "x ♯ Q''" by fact
with Q''eq have x'FreshQ': "x' ♯ Q'" by(simp add: name_fresh_left name_calc)
have "Q ⟼a<νx> ≺ Q'" by fact
with x'FreshQ' aeqa' have "Q ⟼a'<νx'> ≺ ([(x, x')] ∙ Q')"
by(simp add: alphaBoundOutput)
moreover have "⋀C. F C Q a x' ([(x, x')] ∙ Q')"
proof -
fix C
have "⋀C a' x' Q''. ⟦a<νx> ≺ Q' = a'<νx'> ≺ Q''; x' ♯ Q⟧ ⟹ F C Q a' x' Q''" by fact
moreover with aeqa' xineqx' x'FreshQ' have "a<νx> ≺ Q' = a'<νx'> ≺ ([(x, x')] ∙ Q')"
by(simp add: residual.inject name_abs_eq name_fresh_left name_calc)
ultimately show "F C Q a x' ([(x, x')] ∙ Q')" using x'FreshQ aeqa' by blast
qed
ultimately have "F C (P ∥ Q) a' x' (P ∥ ([(x, x')] ∙ Q'))" using x'FreshP aeqa'
by(blast intro: cPar2B)
with Q''eq show ?case by simp
next
case(Par2F P P' Q α)
thus ?case by(simp add: residual.inject)
next
case(Comm1 P P' Q Q' a b x)
thus ?case by(simp add: residual.inject)
next
case(Comm2 P P' Q Q' a b x)
thus ?case by(simp add: residual.inject)
next
case(Close1 P P' Q Q' a x y)
thus ?case by(simp add: residual.inject)
next
case(Close2 P P' Q Q' a x y)
thus ?case by(simp add: residual.inject)
next
case(ResB P a x P' y C a' x' P'')
have "x ♯ x'" by fact hence xineqx': "x ≠ x'" by simp
moreover have Eq: "a<νx> ≺ (<νy>P') = a'<νx'> ≺ P''" by fact
hence aeqa': "a = a'" by(simp add: residual.inject)
have "y ♯ x'" by fact hence yineqx': "y ≠ x'" by simp
moreover have "x' ♯ <νy>P" by fact
ultimately have x'FreshP: "x' ♯ P" by(simp add: name_fresh_abs)
have yineqx: "y ≠ x" and yineqa: "y ≠ a" and yFreshC: "y ♯ C" by fact+
have P''eq: "P'' = <νy>([(x, x')] ∙ P')"
proof -
from Eq xineqx' have "<νy>P' = [(x, x')] ∙ P''"
by(simp add: residual.inject name_abs_eq)
hence "([(x, x')] ∙ (<νy>P')) = P''" by simp
with yineqx' yineqx show ?thesis by(simp add: name_fresh_fresh)
qed
have "x ♯ P''" by fact
with P''eq yineqx have x'FreshP': "x' ♯ P'" by(simp add: name_fresh_left name_calc name_fresh_abs)
have "P ⟼a<νx> ≺ P'" by fact
with x'FreshP' aeqa' have "P ⟼a'<νx'> ≺ ([(x, x')] ∙ P')"
by(simp add: alphaBoundOutput)
moreover have "⋀C. F C P a x' ([(x, x')] ∙ P')"
proof -
fix C
have "⋀C a' x' P''. ⟦a<νx> ≺ P' = a'<νx'> ≺ P''; x' ♯ P⟧ ⟹ F C P a' x' P''" by fact
moreover with aeqa' xineqx' x'FreshP' have "a<νx> ≺ P' = a'<νx'> ≺ ([(x, x')] ∙ P')"
by(simp add: residual.inject name_abs_eq name_fresh_left name_calc)
ultimately show "F C P a x' ([(x, x')] ∙ P')" using x'FreshP aeqa' by blast
qed
ultimately have "F C (<νy>P) a' x' (<νy>([(x, x')] ∙ P'))" using yineqx' yineqa yFreshC aeqa'
by(force intro: cResB)
with P''eq show ?case by simp
next
case(ResF P P' α y)
thus ?case by(simp add: residual.inject)
next
case(Bang P Rs)
thus ?case by(force intro: cBang)
qed
qed
with a xFreshP show ?thesis by simp
qed
lemma tauInduct[consumes 1, case_names Tau Match Mismatch Sum1 Sum2 Par1 Par2 Comm1 Comm2 Close1 Close2 Res Bang]:
fixes P :: pi
and P' :: pi
and F :: "'a::fs_name ⇒ pi ⇒ pi ⇒ bool"
and C :: "'a::fs_name"
assumes Trans: "P ⟼τ ≺ P'"
and "⋀P C. F C (τ.(P)) P"
and "⋀P P' a C. ⟦P ⟼τ ≺ P'; ⋀C. F C P P'⟧ ⟹ F C ([a⌢a]P) P'"
and "⋀P P' a b C. ⟦P ⟼τ ≺ P'; ⋀C. F C P P'; a ≠ b⟧ ⟹ F C ([a≠b]P) P'"
and "⋀P P' Q C. ⟦P ⟼τ ≺ P'; ⋀C. F C P P'⟧ ⟹ F C (P ⊕ Q) P'"
and "⋀Q Q' P C. ⟦Q ⟼τ ≺ Q'; ⋀C. F C Q Q'⟧ ⟹ F C (P ⊕ Q) Q'"
and "⋀P P' Q C. ⟦P ⟼τ ≺ P'; ⋀C. F C P P'⟧ ⟹ F C (P ∥ Q) (P' ∥ Q)"
and "⋀Q Q' P C. ⟦Q ⟼τ ≺ Q'; ⋀C. F C Q Q'⟧ ⟹ F C (P ∥ Q) (P ∥ Q')"
and "⋀P a b P' Q Q' C. ⟦P ⟼a<b> ≺ P'; Q ⟼OutputR a b ≺ Q'⟧ ⟹ F C (P ∥ Q) (P' ∥ Q')"
and "⋀P a b P' Q Q' C. ⟦P ⟼OutputR a b ≺ P'; Q ⟼a<b> ≺ Q'⟧ ⟹ F C (P ∥ Q) (P' ∥ Q')"
and "⋀P a x P' Q Q' C. ⟦P ⟼a<x> ≺ P'; Q ⟼a<νx> ≺ Q'; x ♯ P; x ♯ Q; x ≠ a; x ♯ C⟧ ⟹ F C (P ∥ Q) (<νx>(P' ∥ Q'))"
and "⋀P a x P' Q Q' C. ⟦P ⟼a<νx> ≺ P'; Q ⟼a<x> ≺ Q'; x ♯ P; x ♯ Q; x ≠ a; x ♯ C⟧ ⟹ F C (P ∥ Q) (<νx>(P' ∥ Q'))"
and "⋀P P' x C. ⟦P ⟼τ ≺ P'; x ♯ C; ⋀C. F C P P'⟧ ⟹
F C (<νx>P) (<νx>P')"
and "⋀P P' C. ⟦P ∥ !P ⟼τ ≺ P'; ⋀C. F C (P ∥ !P) P'⟧ ⟹ F C (!P) P'"
shows "F C P P'"
using ‹P ⟼τ ≺ P'›
by(nominal_induct x2=="τ ≺ P'" avoiding: C arbitrary: P' rule: TransitionsEarly.strong_induct)
(auto simp add: residual.inject intro: assms)+
inductive bangPred :: "pi ⇒ pi ⇒ bool"
where
aux1: "bangPred P (!P)"
| aux2: "bangPred P (P ∥ !P)"
inductive_cases tauCases'[simplified pi.distinct residual.distinct]: "τ.(P) ⟼ Rs"
inductive_cases inputCases'[simplified pi.inject residual.inject]: "a<b>.P ⟼ Rs"
inductive_cases outputCases'[simplified pi.inject residual.inject]: "a{b}.P ⟼ Rs"
inductive_cases matchCases'[simplified pi.inject residual.inject]: "[a⌢b]P ⟼ Rs"
inductive_cases mismatchCases'[simplified pi.inject residual.inject]: "[a≠b]P ⟼ Rs"
inductive_cases sumCases'[simplified pi.inject residual.inject]: "P ⊕ Q ⟼ Rs"
inductive_cases parCasesB'[simplified pi.distinct residual.distinct]: "A ∥ B ⟼ b<νy> ≺ A'"
inductive_cases parCasesF'[simplified pi.distinct residual.distinct]: "P ∥ Q ⟼ α ≺ P'"
inductive_cases resCasesB'[simplified pi.distinct residual.distinct]: "<νx'>A ⟼ a<νy'> ≺ A'"
inductive_cases resCasesF'[simplified pi.distinct residual.distinct]: "<νx>A ⟼ α ≺ A'"
lemma tauCases:
fixes P :: pi
and α :: freeRes
and P' :: pi
assumes "τ.(P) ⟼α ≺ P'"
and "Prop (τ) P"
shows "Prop α P'"
using assms
by(cases rule: tauCases') (auto simp add: pi.inject residual.inject)
lemma inputCases[consumes 1, case_names cInput]:
fixes a :: name
and x :: name
and P :: pi
and P' :: pi
assumes Input: "a<x>.P ⟼α ≺ P'"
and A: "⋀u. Prop (a<u>) (P[x::=u])"
shows "Prop α P'"
proof -
{
fix x P
assume "a<x>.P ⟼α ≺ P'"
moreover assume "(x::name) ♯ α" and "x ♯ P'" and "x ≠ a"
moreover assume "⋀u. Prop (a<u>) (P[x::=u])"
moreover obtain z::name where "z ≠ x" and "z ♯ P" and "z ♯ α" and "z ♯ P'" and "z ≠ a"
by(generate_fresh "name", auto simp add: fresh_prod)
moreover obtain z'::name where "z' ≠ x" and "z' ≠ z" and "z' ♯ P" and "z' ♯ α" and "z' ♯ P'" and "z' ≠ a"
by(generate_fresh "name", auto simp add: fresh_prod)
ultimately have "Prop α P'"
by(cases rule: TransitionsEarly.strong_cases[where x=x and b=z and xa=z and xb=z and xc=z and xd=z and xe=z
and y=z' and ya=z'])
(auto simp add: pi.inject residual.inject abs_fresh alpha)
}
note Goal = this
obtain y::name where "y ♯ P" and "y ♯ α" and "y ♯ P'" and "y ≠ a"
by(generate_fresh "name") (auto simp add: fresh_prod)
from Input ‹y ♯ P› have "a<y>.([(x, y)] ∙ P) ⟼α ≺ P'" by(simp add: alphaInput)
moreover note ‹y ♯ α› ‹y ♯ P'› ‹y ≠ a›
moreover from A ‹y ♯ P› have "⋀u. Prop (a<u>) (([(x, y)] ∙ P)[y::=u])"
by(simp add: renaming name_swap)
ultimately show ?thesis by(rule Goal)
qed
lemma outputCases:
fixes P :: pi
and α :: freeRes
and P' :: pi
assumes "a{b}.P ⟼α ≺ P'"
and "Prop (OutputR a b) P"
shows "Prop α P'"
using assms
by(cases rule: outputCases') (auto simp add: pi.inject residual.inject)
lemma zeroTrans[dest]:
fixes Rs :: residual
assumes "𝟬 ⟼ e Rs"
shows "False"
using assms
by - (ind_cases "𝟬 ⟼ e Rs")
lemma mismatchTrans[dest]:
fixes a :: name
and P :: pi
and Rs :: residual
assumes "[a≠a]P ⟼ Rs"
shows "False"
using assms
by(erule_tac mismatchCases') auto
lemma matchCases[consumes 1, case_names Match]:
fixes a :: name
and b :: name
and P :: pi
and Rs :: residual
and F :: "name ⇒ name ⇒ bool"
assumes Trans: "[a⌢b]P ⟼ Rs"
and cMatch: "P ⟼ Rs ⟹ F a a"
shows "F a b"
using assms
by(erule_tac matchCases', auto)
lemma mismatchCases[consumes 1, case_names Mismatch]:
fixes a :: name
and b :: name
and P :: pi
and Rs :: residual
and F :: "name ⇒ name ⇒ bool"
assumes Trans: "[a≠b]P ⟼ Rs"
and cMatch: "⟦P ⟼ Rs; a ≠ b⟧ ⟹ F a b"
shows "F a b"
using assms
by(erule_tac mismatchCases') auto
lemma sumCases[consumes 1, case_names Sum1 Sum2]:
fixes P :: pi
and Q :: pi
and Rs :: residual
assumes Trans: "P ⊕ Q ⟼ Rs"
and cSum1: "P ⟼ Rs ⟹ F"
and cSum2: "Q ⟼ Rs ⟹ F"
shows F
using assms
by(erule_tac sumCases') auto
lemma parCasesB[consumes 1, case_names cPar1 cPar2]:
fixes P :: pi
and Q :: pi
and a :: name
and x :: name
and PQ' :: pi
assumes Trans: "P ∥ Q ⟼ a<νx> ≺ PQ'"
and icPar1B: "⋀P'. ⟦P ⟼ a<νx> ≺ P'; x ♯ Q⟧ ⟹ F (P' ∥ Q)"
and icPar2B: "⋀Q'. ⟦Q ⟼ a<νx> ≺ Q'; x ♯ P⟧ ⟹ F (P ∥ Q')"
shows "F PQ'"
proof -
from Trans show ?thesis
proof(induct rule: parCasesB', auto simp add: pi.inject residual.inject)
fix P' y
assume PTrans: "P ⟼ a<νy> ≺ P'"
assume yFreshQ: "y ♯ (Q::pi)"
assume absEq: "[x].PQ' = [y].(P' ∥ Q)"
have "∃c::name. c ♯ (P', x, y, Q)" by(blast intro: name_exists_fresh)
then obtain c where cFreshP': "c ♯ P'" and cineqx: "x ≠ c" and cineqy: "c ≠ y" and cFreshQ: "c ♯ Q"
by(force simp add: fresh_prod name_fresh)
from cFreshP' PTrans have Trans: "P ⟼ a<νc> ≺ ([(y, c)] ∙ P')" by(simp add: alphaBoundOutput)
from cFreshP' cFreshQ have "c ♯ P' ∥ Q" by simp
hence "[y].(P' ∥ Q) = [c].([(y, c)] ∙ (P' ∥ Q))"
by(auto simp add: alpha fresh_left calc_atm)
with yFreshQ cFreshQ have "[y].(P' ∥ Q) = [c].(([(y, c)] ∙ P') ∥ Q)"
by(simp add: name_fresh_fresh)
with cineqx absEq have L1: "PQ' = [(x, c)] ∙ (([(y, c)] ∙ P') ∥ Q)" and L2: "x ♯ ([(y, c)] ∙ P') ∥ Q"
by(simp add: name_abs_eq)+
from L2 have xFreshQ: "x ♯ Q" and xFreshP': "x ♯ [(y, c)] ∙ P'" by simp+
with cFreshQ L1 have L3: "PQ' = ([(x, c)] ∙ [(y, c)] ∙ P') ∥ Q" by(simp add: name_fresh_fresh)
from Trans xFreshP' have "P ⟼ a<νx> ≺ ([(x, c)] ∙ [(y, c)] ∙ P')" by(simp add: alphaBoundOutput name_swap)
thus ?thesis using xFreshQ L3
by(blast intro: icPar1B)
next
fix Q' y
assume QTrans: "Q ⟼ a<νy> ≺ Q'"
assume yFreshP: "y ♯ (P::pi)"
assume absEq: "[x].PQ' = [y].(P ∥ Q')"
have "∃c::name. c ♯ (Q', x, y, P)" by(blast intro: name_exists_fresh)
then obtain c where cFreshQ': "c ♯ Q'" and cineqx: "x ≠ c" and cineqy: "c ≠ y" and cFreshP: "c ♯ P"
by(force simp add: fresh_prod name_fresh)
from cFreshQ' QTrans have Trans: "Q ⟼ a<νc> ≺ ([(y, c)] ∙ Q')" by(simp add: alphaBoundOutput)
from cFreshQ' cFreshP have "c ♯ P ∥ Q'" by simp
hence "[y].(P ∥ Q') = [c].([(y, c)] ∙ (P ∥ Q'))"
by(auto simp add: alpha fresh_left calc_atm)
with yFreshP cFreshP have "[y].(P ∥ Q') = [c].(P ∥ ([(y, c)] ∙ Q'))"
by(simp add: name_fresh_fresh)
with cineqx absEq have L1: "PQ' = [(x, c)] ∙ (P ∥ ([(y, c)] ∙ Q'))" and L2: "x ♯ P ∥ ([(y, c)] ∙ Q')"
by(simp add: name_abs_eq)+
from L2 have xFreshP: "x ♯ P" and xFreshQ': "x ♯ [(y, c)] ∙ Q'" by simp+
with cFreshP L1 have L3: "PQ' = P ∥ ([(x, c)] ∙ [(y, c)] ∙ Q')" by(simp add: name_fresh_fresh)
from Trans xFreshQ' have "Q ⟼ a<νx> ≺ ([(x, c)] ∙ [(y, c)] ∙ Q')" by(simp add: alphaBoundOutput name_swap)
thus ?thesis using xFreshP L3
by(blast intro: icPar2B)
qed
qed
lemma parCasesOutput[consumes 1, case_names Par1 Par2]:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
and P' :: pi
assumes "P ∥ Q ⟼a[b] ≺ PQ'"
and "⋀P'. ⟦P ⟼a[b] ≺ P'⟧ ⟹ F (P' ∥ Q)"
and "⋀Q'. ⟦Q ⟼a[b] ≺ Q'⟧ ⟹ F (P ∥ Q')"
shows "F PQ'"
using assms
by(erule_tac parCasesF', auto simp add: pi.inject residual.inject)
lemma parCasesInput[consumes 1, case_names Par1 Par2]:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
and P' :: pi
assumes Trans: "P ∥ Q ⟼a<b> ≺ PQ'"
and icPar1F: "⋀P'. ⟦P ⟼a<b> ≺ P'⟧ ⟹ F (P' ∥ Q)"
and icPar2F: "⋀Q'. ⟦Q ⟼a<b> ≺ Q'⟧ ⟹ F (P ∥ Q')"
shows "F PQ'"
using assms
by(erule_tac parCasesF') (auto simp add: pi.inject residual.inject)
lemma parCasesF[consumes 1, case_names cPar1 cPar2 cComm1 cComm2 cClose1 cClose2]:
fixes P :: pi
and Q :: pi
and α :: freeRes
and P' :: pi
and C :: "'a::fs_name"
assumes Trans: "P ∥ Q ⟼ α ≺ PQ'"
and icPar1F: "⋀P'. ⟦P ⟼ α ≺ P'⟧ ⟹ F α (P' ∥ Q)"
and icPar2F: "⋀Q'. ⟦Q ⟼ α ≺ Q'⟧ ⟹ F α (P ∥ Q')"
and icComm1: "⋀P' Q' a b. ⟦P ⟼ a<b> ≺ P'; Q ⟼ a[b] ≺ Q'⟧ ⟹ F (τ) (P' ∥ Q')"
and icComm2: "⋀P' Q' a b. ⟦P ⟼ a[b] ≺ P'; Q ⟼ a<b> ≺ Q'⟧ ⟹ F (τ) (P' ∥ Q')"
and icClose1: "⋀P' Q' a x. ⟦P ⟼ a<x> ≺ P'; Q ⟼ a<νx> ≺ Q'; x ♯ P; x ♯ C⟧ ⟹ F (τ) (<νx>(P' ∥ Q'))"
and icClose2: "⋀P' Q' a x. ⟦P ⟼ a<νx> ≺ P'; Q ⟼ a<x> ≺ Q'; x ♯ Q; x ♯ C⟧ ⟹ F (τ) (<νx>(P' ∥ Q'))"
shows "F α PQ'"
proof -
from Trans show ?thesis
proof(rule parCasesF', auto)
fix Pa Pa' Qa α'
assume Trans': "Pa ⟼ α' ≺ Pa'"
assume Eq: "P ∥ Q = Pa ∥ Qa"
assume Eq': "α ≺ PQ' = α' ≺ Pa' ∥ Qa"
from Eq have "P = Pa" and "Q = Qa"
by(simp add: pi.inject)+
moreover with Eq' have "α = α'" and "PQ' = Pa' ∥ Q"
by(simp add: residual.inject)+
ultimately show ?thesis using icPar1F Trans'
by simp
next
fix Pa Qa Qa' α'
assume Trans': "Qa ⟼ α' ≺ Qa'"
assume Eq: "P ∥ Q = Pa ∥ Qa"
assume Eq': "α ≺ PQ' = α' ≺ Pa ∥ Qa'"
from Eq have "P = Pa" and "Q = Qa"
by(simp add: pi.inject)+
moreover with Eq' have "α = α'" and "PQ' = P ∥ Qa'"
by(simp add: residual.inject)+
ultimately show ?thesis using icPar2F Trans'
by simp
next
fix Pa Pa' Qa Qa' a b
assume TransP: "Pa ⟼ a<b> ≺ Pa'"
assume TransQ: "Qa ⟼ a[b] ≺ Qa'"
assume Eq: "P ∥ Q = Pa ∥ Qa"
assume Eq': "α ≺ PQ' = τ ≺ Pa' ∥ Qa'"
from TransP TransQ Eq Eq' icComm1 show ?thesis
by(simp add: pi.inject residual.inject)
next
fix Pa Pa' Qa Qa' a b x
assume TransP: "Pa ⟼ (a::name)[b] ≺ Pa'"
assume TransQ: "Qa ⟼ a<b> ≺ Qa'"
assume Eq: "P ∥ Q = Pa ∥ Qa"
assume Eq': "α ≺ PQ' = τ ≺ Pa' ∥ Qa'"
from TransP TransQ Eq Eq' icComm2 show ?thesis
by(simp add: pi.inject residual.inject)
next
fix Pa Pa' Qa Qa' a x
assume TransP: "Pa ⟼ a<x> ≺ Pa'"
assume TransQ: "Qa ⟼ a<νx> ≺ Qa'"
assume xFreshPa: "x ♯ Pa"
assume Eq: "P ∥ Q = Pa ∥ Qa"
assume Eq': "α ≺ PQ' = τ ≺ <νx>(Pa' ∥ Qa')"
have "∃(c::name). c ♯ (Pa, Pa', x, Qa', a, C)"
by(blast intro: name_exists_fresh)
then obtain c::name where cFreshPa: "c ♯ Pa" and cFreshPa': "c ♯ Pa'" and cineqy: "c ≠ x" and cFreshQa': "c ♯ Qa'" and cFreshC: "c ♯ C" and cineqa: "c ≠ a"
by(force simp add: fresh_prod name_fresh)
from cFreshQa' have L1: "a<νx> ≺ Qa' = a<νc> ≺ ([(x, c)] ∙ Qa')"
by(simp add: alphaBoundOutput)
with cFreshQa' cFreshPa' have "c ♯ (Pa' ∥ Qa')"
by simp
then have L4: "<νx>(Pa' ∥ Qa') = <νc>(([(x, c)] ∙ Pa') ∥ ([(x, c)] ∙ Qa'))"
by(simp add: alphaRes)
have TransP: "Pa ⟼ a<c> ≺ [(x, c)] ∙ Pa'"
proof -
from xFreshPa TransP have xineqa: "x≠a" by(force dest: freshAction)
from TransP have "([(x, c)] ∙ Pa) ⟼ [(x, c)] ∙ (a<x> ≺ Pa')"
by(rule TransitionsEarly.eqvt)
with xineqa xFreshPa cFreshPa cineqa show ?thesis
by(simp add: name_fresh_fresh name_calc)
qed
with TransQ L1 L4 icClose1 Eq Eq' cFreshPa cFreshC show ?thesis
by(simp add: residual.inject, simp add: pi.inject)
next
fix Pa Pa' Qa Qa' a x
assume TransP: "Pa ⟼ a<νx> ≺ Pa'"
assume TransQ: "Qa ⟼ a<x> ≺ Qa'"
assume xFreshQa: "x ♯ Qa"
assume Eq: "P ∥ Q = Pa ∥ Qa"
assume Eq': "α ≺ PQ' = τ ≺ <νx>(Pa' ∥ Qa')"
have "∃(c::name). c ♯ (Qa, Pa', x, Qa', a, C)"
by(blast intro: name_exists_fresh)
then obtain c::name where cFreshQa: "c ♯ Qa" and cFreshPa': "c ♯ Pa'" and cineqy: "c ≠ x" and cFreshQa': "c ♯ Qa'" and cFreshC: "c ♯ C" and cineqa: "c ≠ a"
by(force simp add: fresh_prod name_fresh)
from cFreshPa' have L1: "a<νx> ≺ Pa' = a<νc> ≺ ([(x, c)] ∙ Pa')"
by(simp add: alphaBoundOutput)
with cFreshQa' cFreshPa' have "c ♯ (Pa' ∥ Qa')"
by simp
then have L4: "<νx>(Pa' ∥ Qa') = <νc>(([(x, c)] ∙ Pa') ∥ ([(x, c)] ∙ Qa'))"
by(simp add: alphaRes)
have TransQ: "Qa ⟼ a<c> ≺ [(x, c)] ∙ Qa'"
proof -
from xFreshQa TransQ have xineqa: "x≠a" by(force dest: freshAction)
from TransQ have "([(x, c)] ∙ Qa) ⟼ [(x, c)] ∙ (a<x> ≺ Qa')"
by(rule TransitionsEarly.eqvt)
with xineqa xFreshQa cFreshQa cineqa show ?thesis
by(simp add: name_fresh_fresh name_calc)
qed
with TransP L1 L4 icClose2 Eq Eq' cFreshQa cFreshC show ?thesis
by(simp add: residual.inject, simp add: pi.inject)
qed
qed
lemma resCasesF[consumes 2, case_names Res]:
fixes x :: name
and P :: pi
and α :: freeRes
and P' :: pi
assumes Trans: "<νx>P ⟼ α ≺ RP'"
and xFreshAlpha: "x ♯ α"
and rcResF: " ⋀P'. P ⟼ α ≺ P' ⟹ F (<νx>P')"
shows "F RP'"
proof -
from Trans show ?thesis
proof(induct rule: resCasesF', auto)
fix Pa Pa' β y
assume PTrans: "Pa ⟼ β ≺ Pa'"
assume yFreshBeta: "(y::name) ♯ β"
assume TermEq: "<νx>P = <νy>Pa"
assume ResEq: "α ≺ RP' = β ≺ <νy>Pa'"
hence alphaeqbeta: "α = β" and L2: "RP' = <νy>Pa'" by(simp add: residual.inject)+
have "∃(c::name). c ♯ (Pa, α, Pa', x, y)" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshPa: "c ♯ Pa" and cFreshAlpha: "c ♯ α" and cFreshPa': "c ♯ Pa'" and cineqx: "x ≠ c" and cineqy: "c ≠ y"
by(force simp add: fresh_prod name_fresh)
from cFreshPa have "<νy>Pa = <νc>([(y, c)] ∙ Pa)" by(rule alphaRes)
with TermEq cineqx have Peq: "P = [(x, c)] ∙ [(y, c)] ∙ Pa" and xeq: "x ♯ [(y, c)] ∙ Pa"
by(simp add: pi.inject name_abs_eq)+
from PTrans have "([(y, c)] ∙ Pa) ⟼ [(y, c)] ∙ (β ≺ Pa')" by(rule TransitionsEarly.eqvt)
with yFreshBeta cFreshAlpha alphaeqbeta have PTrans': "([(y, c)] ∙ Pa) ⟼ α ≺ ([(y, c)] ∙ Pa')"
by(simp add: name_fresh_fresh)
from PTrans' have "([(x, c)] ∙ [(y, c)] ∙ Pa) ⟼ [(x, c)] ∙ (α ≺ [(y, c)] ∙ Pa')"
by(rule TransitionsEarly.eqvt)
with xFreshAlpha cFreshAlpha Peq have PTrans'': "P ⟼ α ≺ [(x, c)] ∙ [(y, c)] ∙ Pa'"
by(simp add: name_fresh_fresh)
from PTrans' xeq xFreshAlpha have xeq': "x ♯ [(y, c)] ∙ Pa'"
by(nominal_induct α rule: freeRes.strong_induct)
(auto simp add: fresh_left calc_atm eqvts dest: freshTransition)
from cFreshPa' have "<νy>Pa' = <νc>([(y, c)] ∙ Pa')" by(rule alphaRes)
moreover from xeq' have "<νc>([(y, c)] ∙ Pa') = <νx>([(c, x)] ∙ [(y, c)] ∙ Pa')"
by(rule alphaRes)
ultimately have "RP' = <νx>([(x, c)] ∙ [(y, c)] ∙ Pa')" using ResEq
by(simp add: residual.inject name_swap)
with PTrans'' xFreshAlpha show ?thesis
by(blast intro: rcResF)
qed
qed
lemma resCasesB[consumes 2, case_names Open Res]:
fixes x :: name
and P :: pi
and a :: name
and y :: name
and RP' :: pi
assumes Trans: "<νy>P ⟼ a<νx> ≺ RP'"
and xineqy: "x ≠ y"
and rcOpen: "⋀P'. ⟦P ⟼(OutputR a y) ≺ P'; a ≠ y⟧ ⟹ F ([(x, y)] ∙ P')"
and rcResB: "⋀P'. ⟦P ⟼a<νx> ≺ P'; y ≠ a⟧ ⟹ F (<νy>P')"
shows "F RP'"
proof -
from Trans show ?thesis
proof(induct rule: resCasesB', auto)
fix Pa Pa' aa b
assume PTrans: "Pa ⟼ (aa::name)[b] ≺ Pa'"
assume aaineqb: "aa≠b"
assume TermEq: "<νy>P = <νb>Pa"
assume ResEq: "a<νx> ≺ RP' = aa<νb> ≺ Pa'"
have "∃(c::name). c ♯ (x, a, aa, y, Pa, Pa', b)" by(blast intro: name_exists_fresh)
then obtain c where cineqx: "c≠x" and cFresha: "c ♯ a" and cineqy: "c ≠ y" and cineqaa: "c ≠ aa" and cFreshPa: "c ♯ Pa" and cFreshPa': "c ♯ Pa'" and cineqb: "c ≠ b"
by(force simp add: fresh_prod name_fresh)
from cFreshPa have "<νb>Pa = <νc>([(b, c)] ∙ Pa)" by(rule alphaRes)
with cineqy TermEq have PEq: "P = [(y, c)] ∙ [(b, c)] ∙ Pa" and yFreshPa: "y ♯ [(b, c)] ∙ Pa"
by(simp add: pi.inject name_abs_eq)+
from PTrans have "([(b, c)] ∙ Pa) ⟼ ([(b, c)] ∙ (aa[b] ≺ Pa'))" by(rule TransitionsEarly.eqvt)
with aaineqb cineqaa have L1: "([(b, c)] ∙ Pa) ⟼ aa[c] ≺ [(b, c)] ∙ Pa'" by(simp add: name_calc)
with yFreshPa have yineqaa: "y ≠ aa" by(force dest: freshAction)
from L1 yFreshPa cineqy have yFreshPa': "y ♯ [(b, c)] ∙ Pa'" by(force intro: freshTransition)
from L1 have "([(y, c)] ∙ [(b, c)] ∙ Pa) ⟼ [(y, c)] ∙ (aa[c] ≺ [(b, c)] ∙ Pa')"
by(rule TransitionsEarly.eqvt)
with cineqaa yineqaa cineqy PEq have PTrans: "P ⟼ aa[y] ≺ [(y, c)] ∙ [(b, c)] ∙ Pa'"
by(simp add: name_calc)
moreover from cFreshPa' have "aa<νb> ≺ Pa' = aa<νc> ≺ ([(b, c)] ∙ Pa')" by(rule alphaBoundOutput)
with ResEq cineqx have ResEq': "RP' = [(x, c)] ∙ [(b, c)] ∙ Pa'" and "x ♯ [(b, c)] ∙ Pa'"
by(simp add: residual.inject name_abs_eq)+
with xineqy cineqy cineqx yFreshPa' have "RP' = [(x, y)] ∙ [(y, c)] ∙ [(b, c)] ∙ Pa'"
by(subst pt_perm_compose[OF pt_name_inst, OF at_name_inst], simp add: name_calc name_fresh_fresh)
moreover from ResEq have "a=aa" by(simp add: residual.inject)
ultimately show ?thesis using yineqaa rcOpen
by blast
next
fix Pa Pa' aa xa ya
assume PTrans: "Pa ⟼ aa<νxa> ≺ Pa'"
assume yaFreshaa: "(ya::name) ≠ aa"
assume yaineqxa: "ya ≠ xa"
assume EqTrans: "<νy>P = <νya>Pa"
assume EqRes: "a<νx> ≺ RP' = aa<νxa> ≺ (<νya>Pa')"
hence aeqaa: "a = aa" by(simp add: residual.inject)
with yaFreshaa have yaFresha: "ya ♯ a" by simp
have "∃(c::name). c ♯ (Pa', y, xa, ya, x, Pa, aa)" by(blast intro: name_exists_fresh)
then obtain c where cFreshPa': "c ♯ Pa'" and cineqy: "c ≠ y" and cineqxa: "c ≠ xa" and cineqya: "c ≠ ya" and cineqx: "c ≠ x" and cFreshP: "c ♯ Pa" and cFreshaa: "c ♯ aa"
by(force simp add: fresh_prod name_fresh)
have "∃(d::name). d ♯ (Pa, a, x, Pa', c, xa, ya, y)" by(blast intro: name_exists_fresh)
then obtain d where dFreshPa: "d ♯ Pa" and dFresha: "d ♯ a" and dineqx: "d ≠ x" and dFreshPa': "d ♯ Pa'" and dineqc: "d≠c" and dineqxa: "d ≠ xa" and dineqya: "d ≠ ya" and dineqy: "d ≠ y"
by(force simp add: fresh_prod name_fresh)
from dFreshPa have "<νya>Pa = <νd>([(ya, d)] ∙ Pa)" by(rule alphaRes)
with EqTrans dineqy have PEq: "P = [(y, d)] ∙ [(ya, d)] ∙ Pa"
and yFreshPa: "y ♯ [(ya, d)] ∙ Pa"
by(simp add: pi.inject name_abs_eq)+
from dFreshPa' have L1: "<νya>Pa' = <νd>([(ya, d)] ∙ Pa')" by(rule alphaRes)
from cFreshPa' dineqc cineqya have "c ♯ <νd>([(ya, d)] ∙ Pa')"
by(simp add: name_fresh_abs name_calc name_fresh_left)
hence "aa<νxa> ≺ (<νd>([(ya, d)] ∙ Pa')) = aa<νc> ≺ ([(xa, c)] ∙ <νd>([(ya, d)] ∙ Pa'))" (is "?LHS = _")
by(rule alphaBoundOutput)
with dineqxa dineqc have "?LHS = aa<νc> ≺ (<νd>([(xa, c)] ∙ [(ya, d)] ∙ Pa'))"
by(simp add: name_calc)
with L1 EqRes cineqx dineqc dineqx have
RP'Eq: "RP' = <νd>([(x, c)] ∙ [(xa, c)] ∙ [(ya, d)] ∙ Pa')"
and xFreshPa': "x ♯ [(xa, c)] ∙ [(ya, d)] ∙ Pa'"
by(simp add: residual.inject name_abs_eq name_fresh_abs name_calc)+
from PTrans aeqaa have "([(ya, d)] ∙ Pa) ⟼ [(ya, d)] ∙ (a<νxa> ≺ Pa')"
by(blast intro: TransitionsEarly.eqvt)
with yaineqxa yaFresha dineqxa dFresha have L1:
"([(ya, d)] ∙ Pa) ⟼ a<νxa> ≺ ([(ya, d)] ∙ Pa')" by(simp add: name_calc name_fresh_fresh)
with yFreshPa have yineqa: "y ≠ a" by(force dest: freshAction)
from dineqc cineqya cFreshPa' have "c ♯ [(ya, d)] ∙ Pa'"
by(simp add: name_fresh_left name_calc)
hence "a<νxa> ≺ ([(ya, d)] ∙ Pa') = a<νc> ≺ ([(xa, c)] ∙ [(ya, d)] ∙ Pa')" (is "?LHS = _")
by(rule alphaBoundOutput)
with xFreshPa' have L2: "?LHS = a<νx> ≺ ([(c, x)] ∙ [(xa, c)] ∙ [(ya, d)] ∙ Pa')"
by(simp add: alphaBoundOutput)
with L1 PEq have "P ⟼ [(y, d)] ∙ (a<νx> ≺ ([(c, x)] ∙ [(xa, c)] ∙ [(ya, d)] ∙ Pa'))"
by(force intro: TransitionsEarly.eqvt simp del: residual.perm)
with yineqa dFresha xineqy dineqx have Trans: "P ⟼ a<νx> ≺ ([(y, d)] ∙ [(c, x)] ∙ [(xa, c)] ∙ [(ya, d)] ∙ Pa')"
by(simp add: name_calc name_fresh_fresh)
from L1 L2 yFreshPa xineqy have "y ♯ [(c, x)] ∙ [(xa, c)] ∙ [(ya, d)] ∙ Pa'"
by(force intro: freshTransition)
with RP'Eq have "RP' = <νy>([(y, d)] ∙ [(c, x)] ∙ [(xa, c)] ∙ [(ya, d)] ∙ Pa')"
by(simp add: alphaRes name_swap)
with Trans yineqa show ?thesis
by(blast intro: rcResB)
qed
qed
lemma bangInduct[consumes 1, case_names Par1B Par1F Par2B Par2F Comm1 Comm2 Close1 Close2 Bang]:
fixes F :: "'a::fs_name ⇒ pi ⇒ residual ⇒ bool"
and P :: pi
and Rs :: residual
and C :: "'a::fs_name"
assumes Trans: "!P ⟼ Rs"
and cPar1B: "⋀a x P' C. ⟦P ⟼ a<νx> ≺ P'; x ♯ P; x ♯ C⟧ ⟹ F C (P ∥ !P) (a<νx> ≺ (P' ∥ !P))"
and cPar1F: "⋀(α::freeRes) (P'::pi) C. ⟦P ⟼ α ≺ P'⟧ ⟹ F C (P ∥ !P) (α ≺ P' ∥ !P)"
and cPar2B: "⋀a x P' C. ⟦!P ⟼ a<νx> ≺ P'; x ♯ P; x ♯ C; ⋀C. F C (!P) (a<νx> ≺ P')⟧ ⟹ F C (P ∥ !P) (a<νx> ≺ (P ∥ P'))"
and cPar2F: "⋀α P' C. ⟦!P ⟼ α ≺ P'; ⋀C. F C (!P) (α ≺ P')⟧ ⟹ F C (P ∥ !P) (α ≺ P ∥ P')"
and cComm1: "⋀a P' b P'' C. ⟦P ⟼ a<b> ≺ P'; !P ⟼ (OutputR a b) ≺ P''; ⋀C. F C (!P) ((OutputR a b) ≺ P'')⟧ ⟹
F C (P ∥ !P) (τ ≺ P' ∥ P'')"
and cComm2: "⋀a b P' P'' C. ⟦P ⟼ (OutputR a b) ≺ P'; !P ⟼ a<b> ≺ P''; ⋀C. F C (!P) (a<b> ≺ P'')⟧ ⟹
F C (P ∥ !P) (τ ≺ P' ∥ P'')"
and cClose1: "⋀a x P' P'' C. ⟦P ⟼ a<x> ≺ P'; !P ⟼ a<νx> ≺ P''; x ♯ P; x ♯ C; ⋀C. F C (!P) (a<νx> ≺ P'')⟧ ⟹
F C (P ∥ !P) (τ ≺ <νx>(P' ∥ P''))"
and cClose2: "⋀a x P' P'' C. ⟦P ⟼ a<νx> ≺ P'; !P ⟼ a<x> ≺ P''; x ♯ P; x ♯ C; ⋀C. F C (!P) (a<x> ≺ P'')⟧ ⟹
F C (P ∥ !P) (τ ≺ <νx>(P' ∥ P''))"
and cBang: "⋀Rs C. ⟦P ∥ !P ⟼ Rs; ⋀C. F C (P ∥ !P) Rs⟧ ⟹ F C (!P) Rs"
shows "F C (!P) Rs"
proof -
have "⋀X Y C. ⟦X ⟼ Y; bangPred P X⟧ ⟹ F C X Y"
proof -
fix X Y C
assume "X ⟼ Y" and "bangPred P X"
thus "F C X Y"
proof(nominal_induct avoiding: C rule: TransitionsEarly.strong_induct)
case(Tau Pa)
thus ?case
apply -
by(ind_cases "bangPred P (τ.(Pa))")
next
case(Input x a u Pa C)
thus ?case
by - (ind_cases "bangPred P (a<x>.Pa)")
next
case(Output a b Pa C)
thus ?case
by - (ind_cases "bangPred P (a{b}.Pa)")
next
case(Match Pa Rs b C)
thus ?case
by - (ind_cases "bangPred P ([b⌢b]Pa)")
next
case(Mismatch Pa Rs a b C)
thus ?case
by - (ind_cases "bangPred P ([a ≠ b]Pa)")
next
case(Open Pa a b Pa')
thus ?case
by - (ind_cases "bangPred P (<νb>Pa)")
next
case(Sum1 Pa Rs Q)
thus ?case
by - (ind_cases "bangPred P (Pa ⊕ Q)")
next
case(Sum2 Q Rs Pa)
thus ?case
by - (ind_cases "bangPred P (Pa ⊕ Q)")
next
case(Par1B Pa a x P' Q C)
thus ?case
by - (ind_cases "bangPred P (Pa ∥ Q)", auto simp add: pi.inject cPar1B)
next
case(Par1F Pa α P' Q C)
thus ?case
by - (ind_cases "bangPred P (Pa ∥ Q)", auto simp add: pi.inject cPar1F)
next
case(Par2B Q a x Q' Pa)
thus ?case
by - (ind_cases "bangPred P (Pa ∥ Q)", auto simp add: pi.inject aux1 cPar2B)
next
case(Par2F Q α Q' Pa)
thus ?case
by - (ind_cases "bangPred P (Pa ∥ Q)", auto simp add: pi.inject intro: cPar2F aux1)
next
case(Comm1 Pa a b Pa' Q Q' C)
thus ?case
by - (ind_cases "bangPred P (Pa ∥ Q)", auto simp add: pi.inject intro: cComm1 aux1)
next
case(Comm2 Pa a b Pa' Q P'' C)
thus ?case
by - (ind_cases "bangPred P (Pa ∥ Q)", auto simp add: pi.inject intro: cComm2 aux1)
next
case(Close1 Pa a x Pa' Q Q'' C)
thus ?case
by - (ind_cases "bangPred P (Pa ∥ Q)", auto simp add: pi.inject aux1 cClose1)
next
case(Close2 Pa a x Pa' Q Q' C)
thus ?case
by - (ind_cases "bangPred P (Pa ∥ Q)", auto simp add: pi.inject aux1 cClose2)
next
case(ResB Pa a x Pa' y)
thus ?case
by - (ind_cases "bangPred P (<νy>Pa)")
next
case(ResF Pa α Pa' y)
thus ?case
by - (ind_cases "bangPred P (<νy>Pa)")
next
case(Bang Pa Rs)
thus ?case
by - (ind_cases "bangPred P (!Pa)", auto simp add: pi.inject intro: aux2 cBang)
qed
qed
with Trans show ?thesis by(force intro: bangPred.aux1)
qed
end
Theory Strong_Early_Sim
theory Strong_Early_Sim
imports Early_Semantics Rel
begin
definition "strongSimEarly" :: "pi ⇒ (pi × pi) set ⇒ pi ⇒ bool" ("_ ↝[_] _" [80, 80, 80] 80) where
"P ↝[Rel] Q ≡ (∀a y Q'. Q ⟼a<νy> ≺ Q' ⟶ y ♯ P ⟶ (∃P'. P ⟼a<νy> ≺ P' ∧ (P', Q') ∈ Rel)) ∧
(∀α Q'. Q ⟼α ≺ Q' ⟶ (∃P'. P ⟼α ≺ P' ∧ (P', Q') ∈ Rel))"
lemma monotonic:
fixes A :: "(pi × pi) set"
and B :: "(pi × pi) set"
and P :: pi
and P' :: pi
assumes "P ↝[A] P'"
and "A ⊆ B"
shows "P ↝[B] P'"
using assms
by(fastforce simp add: strongSimEarly_def)
lemma freshUnit[simp]:
fixes y :: name
shows "y ♯ ()"
by(auto simp add: fresh_def supp_unit)
lemma simCasesCont[consumes 1, case_names Bound Free]:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and C :: "'a::fs_name"
assumes Eqvt: "eqvt Rel"
and Bound: "⋀a y Q'. ⟦Q ⟼ a<νy> ≺ Q'; y ♯ P; y ♯ Q; y ♯ C⟧ ⟹ ∃P'. P ⟼ a<νy> ≺ P' ∧ (P', Q') ∈ Rel"
and Free: "⋀α Q'. Q ⟼ α ≺ Q' ⟹ ∃P'. P ⟼ α ≺ P' ∧ (P', Q') ∈ Rel"
shows "P ↝[Rel] Q"
proof -
from Free show ?thesis
proof(auto simp add: strongSimEarly_def)
fix Q' a y
assume yFreshP: "(y::name) ♯ P"
assume Trans: "Q ⟼ a<νy> ≺ Q'"
have "∃c::name. c ♯ (P, Q', y, Q, C)" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshP: "c ♯ P" and cFreshQ': "c ♯ Q'" and cFreshC: "c ♯ C"
and cineqy: "c ≠ y" and "c ♯ Q"
by(force simp add: fresh_prod name_fresh)
from Trans cFreshQ' have "Q ⟼ a<νc> ≺ ([(y, c)] ∙ Q')" by(simp add: alphaBoundOutput)
hence "∃P'. P ⟼ a<νc> ≺ P' ∧ (P', [(y, c)] ∙ Q') ∈ Rel" using ‹c ♯ P› ‹c ♯ Q› ‹c ♯ C›
by(rule Bound)
then obtain P' where PTrans: "P ⟼ a<νc> ≺ P'" and P'RelQ': "(P', [(y, c)] ∙ Q') ∈ Rel"
by blast
from PTrans yFreshP cineqy have yFreshP': "y ♯ P'" by(force intro: freshTransition)
with PTrans have "P ⟼ a<νy> ≺ ([(y, c)] ∙ P')" by(simp add: alphaBoundOutput name_swap)
moreover have "([(y, c)] ∙ P', Q') ∈ Rel" (is "?goal")
proof -
from Eqvt P'RelQ' have "([(y, c)] ∙ P', [(y, c)] ∙ [(y, c)] ∙ Q') ∈ Rel"
by(rule eqvtRelI)
with cineqy show ?goal by(simp add: name_calc)
qed
ultimately show "∃P'. P ⟼a<νy> ≺ P' ∧ (P', Q') ∈ Rel" by blast
qed
qed
lemma simCases[consumes 0, case_names Bound Free]:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and C :: "'a::fs_name"
assumes Bound: "⋀a y Q'. ⟦Q ⟼ a<νy> ≺ Q'; y ♯ P⟧ ⟹ ∃P'. P ⟼ a<νy> ≺ P' ∧ (P', Q') ∈ Rel"
and Free: "⋀α Q'. Q ⟼ α ≺ Q' ⟹ ∃P'. P ⟼ α ≺ P' ∧ (P', Q') ∈ Rel"
shows "P ↝[Rel] Q"
using assms
by(auto simp add: strongSimEarly_def)
lemma elim:
fixes P :: pi
and Rel :: "(pi × pi) set"
and Q :: pi
and a :: name
and x :: name
and Q' :: pi
assumes "P ↝[Rel] Q"
shows "Q ⟼ a<νx> ≺ Q' ⟹ x ♯ P ⟹ ∃P'. P ⟼ a<νx> ≺ P' ∧ (P', Q') ∈ Rel"
and "Q ⟼ α ≺ Q' ⟹ ∃P'. P ⟼ α ≺ P' ∧ (P', Q') ∈ Rel"
using assms by(simp add: strongSimEarly_def)+
lemma eqvtI:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and perm :: "name prm"
assumes Sim: "P ↝[Rel] Q"
and RelRel': "Rel ⊆ Rel'"
and EqvtRel': "eqvt Rel'"
shows "(perm ∙ P) ↝[Rel'] (perm ∙ Q)"
proof(induct rule: simCases)
case(Bound a y Q')
have Trans: "(perm ∙ Q) ⟼ a<νy> ≺ Q'" by fact
have yFreshP: "y ♯ perm ∙ P" by fact
from Trans have "(rev perm ∙ (perm ∙ Q)) ⟼ rev perm ∙ (a<νy> ≺ Q')"
by(rule TransitionsEarly.eqvt)
hence "Q ⟼ (rev perm ∙ a)<ν(rev perm ∙ y)> ≺ (rev perm ∙ Q')"
by(simp add: name_rev_per)
moreover from yFreshP have "(rev perm ∙ y) ♯ P" by(simp add: name_fresh_left)
ultimately have "∃P'. P ⟼ (rev perm ∙ a)<ν(rev perm ∙ y)> ≺ P' ∧ (P', rev perm ∙ Q') ∈ Rel" using Sim
by(force intro: elim)
then obtain P' where PTrans: "P ⟼ (rev perm ∙ a)<ν(rev perm ∙ y)> ≺ P'" and P'RelQ': "(P', rev perm ∙ Q') ∈ Rel"
by blast
from PTrans have "(perm ∙ P) ⟼ perm ∙ ((rev perm ∙ a)<ν(rev perm ∙ y)> ≺ P')" by(rule TransitionsEarly.eqvt)
hence L1: "(perm ∙ P) ⟼ a<νy> ≺ (perm ∙ P')" by(simp add: name_per_rev)
from P'RelQ' RelRel' have "(P', rev perm ∙ Q') ∈ Rel'" by blast
with EqvtRel' have "(perm ∙ P', perm ∙ (rev perm ∙ Q')) ∈ Rel'"
by(rule eqvtRelI)
hence "(perm ∙ P', Q') ∈ Rel'" by(simp add: name_per_rev)
with L1 show ?case by blast
next
case(Free α Q')
have Trans: "(perm ∙ Q) ⟼ α ≺ Q'" by fact
from Trans have "(rev perm ∙ (perm ∙ Q)) ⟼ rev perm ∙ (α ≺ Q')"
by(rule TransitionsEarly.eqvt)
hence "Q ⟼ (rev perm ∙ α) ≺ (rev perm ∙ Q')"
by(simp add: name_rev_per)
with Sim have "∃P'. P ⟼ (rev perm ∙ α) ≺ P' ∧ (P', (rev perm ∙ Q')) ∈ Rel"
by(force intro: elim)
then obtain P' where PTrans: "P ⟼ (rev perm ∙ α) ≺ P'" and PRel: "(P', (rev perm ∙ Q')) ∈ Rel" by blast
from PTrans have "(perm ∙ P) ⟼ perm ∙ ((rev perm ∙ α)≺ P')" by(rule TransitionsEarly.eqvt)
hence L1: "(perm ∙ P) ⟼ α ≺ (perm ∙ P')" by(simp add: name_per_rev)
from PRel EqvtRel' RelRel' have "((perm ∙ P'), (perm ∙ (rev perm ∙ Q'))) ∈ Rel'"
by(force intro: eqvtRelI)
hence "((perm ∙ P'), Q') ∈ Rel'" by(simp add: name_per_rev)
with L1 show ?case by blast
qed
lemma reflexive:
fixes P :: pi
and Rel :: "(pi × pi) set"
assumes "Id ⊆ Rel"
shows "P ↝[Rel] P"
using assms
by(auto simp add: strongSimEarly_def)
lemmas fresh_prod[simp]
lemma transitive:
fixes P :: pi
and Q :: pi
and R :: pi
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
and Rel'' :: "(pi × pi) set"
assumes PSimQ: "P ↝[Rel] Q"
and QSimR: "Q ↝[Rel'] R"
and Eqvt': "eqvt Rel''"
and Trans: "Rel O Rel' ⊆ Rel''"
shows "P ↝[Rel''] R"
proof -
from Eqvt' show ?thesis
proof(induct rule: simCasesCont[where C=Q])
case(Bound a y R')
have RTrans: "R ⟼ a<νy> ≺ R'" by fact
from QSimR RTrans ‹y ♯ Q› have "∃Q'. Q ⟼ a<νy> ≺ Q' ∧ (Q', R') ∈ Rel'"
by(rule elim)
then obtain Q' where QTrans: "Q ⟼ a<νy> ≺ Q'" and Q'Rel'R': "(Q', R') ∈ Rel'" by blast
from PSimQ QTrans ‹y ♯ P› have "∃P'. P ⟼ a<νy> ≺ P' ∧ (P', Q') ∈ Rel"
by(rule elim)
then obtain P' where PTrans: "P ⟼ a<νy> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel" by blast
moreover from P'RelQ' Q'Rel'R' Trans have "(P', R') ∈ Rel''" by blast
ultimately show ?case by blast
next
case(Free α R')
have RTrans: "R ⟼ α ≺ R'" by fact
with QSimR have "∃Q'. Q ⟼ α ≺ Q' ∧ (Q', R') ∈ Rel'" by(rule elim)
then obtain Q' where QTrans: "Q ⟼ α ≺ Q'" and Q'RelR': "(Q', R') ∈ Rel'" by blast
from PSimQ QTrans have "∃P'. P ⟼ α ≺ P' ∧ (P', Q') ∈ Rel" by(rule elim)
then obtain P' where PTrans: "P ⟼ α ≺ P'" and P'RelQ': "(P', Q') ∈ Rel" by blast
from P'RelQ' Q'RelR' Trans have "(P', R') ∈ Rel''" by blast
with PTrans show "∃P'. P ⟼ α ≺ P' ∧ (P', R') ∈ Rel''" by blast
qed
qed
end
Theory Strong_Early_Bisim
theory Strong_Early_Bisim
imports Strong_Early_Sim
begin
lemma monoAux: "A ⊆ B ⟹ P ↝[A] Q ⟶ P ↝[B] Q"
by(auto intro: Strong_Early_Sim.monotonic)
coinductive_set bisim :: "(pi × pi) set"
where
step: "⟦P ↝[bisim] Q; (Q, P) ∈ bisim⟧ ⟹ (P, Q) ∈ bisim"
monos monoAux
abbreviation strongBisimJudge (infixr "∼" 65) where "P ∼ Q ≡ (P, Q) ∈ bisim"
lemma bisimCoinductAux[case_names bisim, case_conclusion StrongBisim step, consumes 1]:
assumes p: "(P, Q) ∈ X"
and step: "⋀P Q. (P, Q) ∈ X ⟹ P ↝[(X ∪ bisim)] Q ∧ (Q, P) ∈ bisim ∪ X"
shows "P ∼ Q"
proof -
have aux: "X ∪ bisim = {(P, Q). (P, Q) ∈ X ∨ P ∼ Q}" by blast
from p show ?thesis
by(coinduct, force dest: step simp add: aux)
qed
lemma bisimCoinduct[consumes 1, case_names cSim cSym]:
fixes P :: pi
and Q :: pi
assumes "(P, Q) ∈ X"
and "⋀R S. (R, S) ∈ X ⟹ R ↝[(X ∪ bisim)] S"
and "⋀R S. (R, S) ∈ X ⟹ (S, R) ∈ X"
shows "P ∼ Q"
using assms
by(coinduct rule: bisimCoinductAux) auto
lemma weak_coinduct[case_names bisim, case_conclusion StrongBisim step, consumes 1]:
assumes p: "(P, Q) ∈ X"
and step: "⋀P Q. (P, Q) ∈ X ⟹ P ↝[X] Q ∧ (Q, P) ∈ X"
shows "P ∼ Q"
using p
proof(coinduct rule: bisimCoinductAux)
case (bisim P)
from step[OF this] show ?case using Strong_Early_Sim.monotonic by blast
qed
lemma bisimWeakCoinduct[consumes 1, case_names cSim cSym]:
fixes P :: pi
and Q :: pi
assumes "(P, Q) ∈ X"
and "⋀P Q. (P, Q) ∈ X ⟹ P ↝[X] Q"
and "⋀P Q. (P, Q) ∈ X ⟹ (Q, P) ∈ X"
shows "P ∼ Q"
using assms
by(coinduct rule: weak_coinduct) auto
lemma monotonic: "mono(λp x1 x2.
∃P Q. x1 = P ∧
x2 = Q ∧ P ↝[{(xa, x). p xa x}] Q ∧ Q ↝[{(xa, x). p xa x}] P)"
apply(rule monoI)
by(auto intro: Strong_Early_Sim.monotonic)
lemma bisimE:
fixes P :: pi
and Q :: pi
assumes "P ∼ Q"
shows "P ↝[bisim] Q"
and "Q ∼ P"
using assms
by(auto intro: bisim.cases)
lemma bisimClosed[eqvt]:
fixes P :: pi
and Q :: pi
and p :: "name prm"
assumes "P ∼ Q"
shows "(p ∙ P) ∼ (p ∙ Q)"
proof -
let ?X = "{(p ∙ P, p ∙ Q) | (p::name prm) P Q. P ∼ Q}"
from assms have "(p ∙ P, p ∙ Q) ∈ ?X" by auto
thus ?thesis
proof(coinduct rule: bisimWeakCoinduct)
case(cSim P Q)
moreover {
fix P Q
fix p::"name prm"
assume "P ↝[bisim] Q"
moreover have "bisim ⊆ ?X"
by(auto, rule_tac x="[]" in exI) auto
moreover have "eqvt ?X"
by(auto simp add: eqvt_def pt2[OF pt_name_inst, THEN sym]) blast
ultimately have "(p ∙ P) ↝[?X] (p ∙ Q)"
by(rule Strong_Early_Sim.eqvtI)
}
ultimately show ?case by(blast dest: bisimE)
next
case(cSym P Q)
thus ?case by(blast dest: bisimE)
qed
qed
lemma eqvt[simp]:
shows "eqvt bisim"
by(auto simp add: eqvt_def eqvts)
lemma reflexive:
fixes P :: pi
shows "P ∼ P"
proof -
have "(P, P) ∈ Id" by simp
then show ?thesis
by(coinduct rule: bisimWeakCoinduct) (auto intro: Strong_Early_Sim.reflexive)
qed
lemma transitive:
fixes P :: pi
and Q :: pi
and R :: pi
assumes PBiSimQ: "P ∼ Q"
and QBiSimR: "Q ∼ R"
shows "P ∼ R"
proof -
let ?X = "bisim O bisim"
from assms have "(P, R) ∈ ?X" by blast
thus ?thesis
proof(coinduct rule: bisimWeakCoinduct)
case(cSim P Q)
moreover {
fix P Q R
assume "P ∼ Q" and "Q ∼ R"
hence "P ↝[bisim] Q" and "Q ↝[bisim] R"
by(metis bisimE)+
moreover from eqvt have "eqvt ?X" by(auto simp add: eqvtTrans)
moreover have "bisim O bisim ⊆ ?X" by auto
ultimately have "P ↝[?X] R"
by(rule Strong_Early_Sim.transitive)
}
ultimately show ?case by auto
next
case(cSym P Q)
thus ?case by(auto dest: bisimE)
qed
qed
end
Theory Strong_Early_Bisim_Subst
theory Strong_Early_Bisim_Subst
imports Strong_Early_Bisim
begin
abbreviation StrongCongEarlyJudge (infixr "∼⇧s" 65) where "P ∼⇧s Q ≡ (P, Q) ∈ (substClosed bisim)"
lemma congBisim:
fixes P :: pi
and Q :: pi
assumes "P ∼⇧s Q"
shows "P ∼ Q"
using assms substClosedSubset by blast
lemma eqvt:
shows "eqvt (substClosed bisim)"
by(rule eqvtSubstClosed[OF Strong_Early_Bisim.eqvt])
lemma eqvtI:
fixes P :: pi
and Q :: pi
and perm :: "name prm"
assumes "P ∼⇧s Q"
shows "(perm ∙ P) ∼⇧s (perm ∙ Q)"
using assms
by(rule eqvtRelI[OF eqvt])
lemma reflexive:
fixes P :: pi
shows "P ∼⇧s P"
by(force simp add: substClosed_def intro: Strong_Early_Bisim.reflexive)
lemma symetric:
fixes P :: pi
and Q :: pi
assumes "P ∼⇧s Q"
shows "Q ∼⇧s P"
using assms
by(force simp add: substClosed_def intro: Strong_Early_Bisim.bisimE)
lemma transitive:
fixes P :: pi
and Q :: pi
and R :: pi
assumes "P ∼⇧s Q"
and "Q ∼⇧s R"
shows "P ∼⇧s R"
using assms
by(force simp add: substClosed_def intro: Strong_Early_Bisim.transitive)
lemma partUnfold:
fixes P :: pi
and Q :: pi
and s :: "(name × name) list"
assumes "P ∼⇧s Q"
shows "P[<s>] ∼⇧s Q[<s>]"
using assms
proof(auto simp add: substClosed_def)
fix s'
assume "∀s. P[<s>] ∼ Q[<s>]"
hence "P[<(s@s')>] ∼ Q[<(s@s')>]" by blast
moreover have "P[<(s@s')>] = (P[<s>])[<s'>]"
by(induct s', auto)
moreover have "Q[<(s@s')>] = (Q[<s>])[<s'>]"
by(induct s', auto)
ultimately show "(P[<s>])[<s'>] ∼ (Q[<s>])[<s'>]"
by simp
qed
end
Theory Strong_Early_Sim_Pres
theory Strong_Early_Sim_Pres
imports Strong_Early_Sim
begin
lemma tauPres:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
assumes PRelQ: "(P, Q) ∈ Rel"
shows "τ.(P) ↝[Rel] τ.(Q)"
proof(induct rule: simCases)
case(Bound a y Q')
have "τ.(Q) ⟼ a<νy> ≺ Q'" by fact
hence False by(induct rule: tauCases', auto)
thus ?case by simp
next
case(Free α Q')
have "τ.(Q) ⟼ α ≺ Q'" by fact
thus "∃P'. τ.(P) ⟼ α ≺ P' ∧ (P', Q') ∈ Rel"
proof(induct rule: tauCases', auto simp add: pi.inject residual.inject)
have "τ.(P) ⟼ τ ≺ P" by(rule TransitionsEarly.Tau)
with PRelQ show "∃P'. τ.(P) ⟼ τ ≺ P' ∧ (P', Q) ∈ Rel" by blast
qed
qed
lemma inputPres:
fixes P :: pi
and x :: name
and Q :: pi
and a :: name
and Rel :: "(pi × pi) set"
assumes PRelQ: "∀y. (P[x::=y], Q[x::=y]) ∈ Rel"
and Eqvt: "eqvt Rel"
shows "a<x>.P ↝[Rel] a<x>.Q"
using Eqvt
proof(induct rule: simCasesCont[where C="(x, a, P, Q)"])
case(Bound b y Q')
from ‹y ♯ (x, a, P, Q)› have "y ≠ x" "y ≠ a" "y ♯ P" "y ♯ Q" by simp+
from ‹a<x>.Q ⟼b<νy> ≺ Q'› ‹y ≠ a› ‹y ≠ x› ‹y ♯ Q› show ?case
by(erule_tac inputCases') auto
next
case(Free α Q')
from ‹a<x>.Q ⟼ α ≺ Q'›
show ?case
proof(induct rule: inputCases)
case(cInput u)
have "a<x>.P ⟼a<u> ≺ P[x::=u]" by(rule Input)
moreover from PRelQ have "(P[x::=u], Q[x::=u]) ∈ Rel" by auto
ultimately show ?case by blast
qed
qed
lemma outputPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes PRelQ: "(P, Q) ∈ Rel"
shows "a{b}.P ↝[Rel] a{b}.Q"
proof(induct rule: simCases)
case(Bound c y Q')
have "a{b}.Q ⟼ c<νy> ≺ Q'" by fact
hence False by(induct rule: outputCases', auto)
thus "∃P'. a{b}.P ⟼ c<νy> ≺ P' ∧ (P', Q') ∈ Rel" by simp
next
case(Free α Q')
have "a{b}.Q ⟼ α ≺ Q'" by fact
thus "∃P'. a{b}.P ⟼ α ≺ P' ∧ (P', Q') ∈ Rel"
proof(induct rule: outputCases', auto simp add: pi.inject residual.inject)
have "a{b}.P ⟼ a[b] ≺ P" by(rule TransitionsEarly.Output)
with PRelQ show "∃P'. a{b}.P ⟼ a[b] ≺ P' ∧ (P', Q) ∈ Rel" by blast
qed
qed
lemma matchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes PSimQ: "P ↝[Rel] Q"
and RelRel': "Rel ⊆ Rel'"
shows "[a⌢b]P ↝[Rel'] [a⌢b]Q"
proof(induct rule: simCases)
case(Bound c y Q')
have "(y::name) ♯ [a⌢b]P" by fact
hence yFreshP: "y ♯ P" by simp
have "[a⌢b]Q ⟼ c<νy> ≺ Q'" by fact
thus ?case
proof(induct rule: matchCases)
case Match
have "Q ⟼c<νy> ≺ Q'" by fact
with PSimQ yFreshP obtain P' where PTrans: "P ⟼c<νy> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: elim)
from PTrans have "[a⌢a]P ⟼ c<νy> ≺ P'" by(rule Early_Semantics.Match)
moreover from P'RelQ' RelRel' have "(P', Q') ∈ Rel'" by blast
ultimately show ?case by blast
qed
next
case(Free α Q')
assume "[a⌢b]Q ⟼ α ≺ Q'"
thus ?case
proof(induct rule: matchCases)
case Match
have "Q ⟼ α ≺ Q'" by fact
with PSimQ obtain P' where PTrans: "P ⟼ α ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: elim)
from PTrans have "[a⌢a]P ⟼α ≺ P'" by(rule TransitionsEarly.Match)
moreover from P'RelQ' RelRel' have "(P', Q') ∈ Rel'" by blast
ultimately show ?case by blast
qed
qed
lemma mismatchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes PSimQ: "P ↝[Rel] Q"
and RelRel': "Rel ⊆ Rel'"
shows "[a≠b]P ↝[Rel'] [a≠b]Q"
proof(cases "a = b")
assume "a = b"
thus ?thesis
by(auto simp add: strongSimEarly_def)
next
assume aineqb: "a ≠ b"
show ?thesis
proof(induct rule: simCases)
case(Bound c x Q')
have "x ♯ [a≠b]P" by fact
hence xFreshP: "x ♯ P" by simp
have "[a≠b]Q ⟼ c<νx> ≺ Q'" by fact
thus ?case
proof(induct rule: mismatchCases)
case Mismatch
have "Q ⟼c<νx> ≺ Q'" by fact
with PSimQ xFreshP obtain P' where PTrans: "P ⟼c<νx> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: elim)
from PTrans aineqb have "[a≠b]P ⟼ c<νx> ≺ P'" by(rule Early_Semantics.Mismatch)
moreover from P'RelQ' RelRel' have "(P', Q') ∈ Rel'" by blast
ultimately show ?case by blast
qed
next
case(Free α Q')
have "[a≠b]Q ⟼α ≺ Q'" by fact
thus ?case
proof(induct rule: mismatchCases)
case Mismatch
have "Q ⟼ α ≺ Q'" by fact
with PSimQ obtain P' where PTrans: "P ⟼ α ≺ P'"
and PRel: "(P', Q') ∈ Rel"
by(blast dest: elim)
from PTrans ‹a ≠ b› have "[a≠b]P ⟼α ≺ P'" by(rule TransitionsEarly.Mismatch)
with RelRel' PRel show ?case by blast
qed
qed
qed
lemma sumPres:
fixes P :: pi
and Q :: pi
and R :: pi
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes "P ↝[Rel] Q"
and C1: "Id ⊆ Rel'"
and "Rel ⊆ Rel'"
shows "P ⊕ R ↝[Rel'] Q ⊕ R"
proof(induct rule: simCases)
case(Bound a y Q')
have "y ♯ P ⊕ R" by fact
hence "(y::name) ♯ P" and "y ♯ R" by simp+
from ‹Q ⊕ R ⟼a<νy> ≺ Q'› show ?case
proof(induct rule: sumCases)
case Sum1
from ‹P ↝[Rel] Q› ‹Q ⟼a<νy> ≺ Q'› ‹y ♯ P› obtain P' where PTrans: "P ⟼a<νy> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: elim)
from PTrans have "P ⊕ R ⟼a<νy> ≺ P'" by(rule Early_Semantics.Sum1)
moreover from P'RelQ' ‹Rel ⊆ Rel'› have "(P', Q') ∈ Rel'" by blast
ultimately show ?case by blast
next
case Sum2
from ‹R ⟼a<νy> ≺ Q'› have "P ⊕ R ⟼a<νy> ≺ Q'" by(rule Early_Semantics.Sum2)
moreover from C1 have "(Q', Q') ∈ Rel'" by auto
ultimately show ?case by blast
qed
next
case(Free α Q')
from ‹Q ⊕ R ⟼α ≺ Q'› show "∃P'. P ⊕ R ⟼ α ≺ P' ∧ (P', Q') ∈ Rel'"
proof(induct rule: sumCases)
case Sum1
have "Q ⟼α ≺ Q'" by fact
with ‹P ↝[Rel] Q› obtain P' where PTrans: "P ⟼α ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: elim)
from PTrans have "P ⊕ R ⟼α ≺ P'" by(rule TransitionsEarly.Sum1)
moreover from P'RelQ' ‹Rel ⊆ Rel'› have "(P', Q') ∈ Rel'" by blast
ultimately show ?case by blast
next
case Sum2
from ‹R ⟼α ≺ Q'› have "P ⊕ R ⟼α ≺ Q'" by(rule TransitionsEarly.Sum2)
moreover from C1 have "(Q', Q') ∈ Rel'" by blast
ultimately show ?case by blast
qed
qed
lemma parCompose:
fixes P :: pi
and Q :: pi
and R :: pi
and T :: pi
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
and Rel'' :: "(pi × pi) set"
assumes PSimQ: "P ↝[Rel] Q"
and RSimT: "R ↝[Rel'] S"
and PRelQ: "(P, Q) ∈ Rel"
and RRel'T: "(R, S) ∈ Rel'"
and Par: "⋀P' Q' R' S'. ⟦(P', Q') ∈ Rel; (R', S') ∈ Rel'⟧ ⟹ (P' ∥ R', Q' ∥ S') ∈ Rel''"
and Res: "⋀S T x. (S, T) ∈ Rel'' ⟹ (<νx>S, <νx>T) ∈ Rel''"
shows "P ∥ R ↝[Rel''] Q ∥ S"
proof(induct rule: simCases)
case(Bound a x Q')
have "x ♯ P ∥ R" by fact
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by simp+
have "Q ∥ S ⟼ a<νx> ≺ Q'" by fact
thus ?case
proof(induct rule: parCasesB)
case(cPar1 Q')
have "Q ⟼ a<νx> ≺ Q'" by fact
with PSimQ xFreshP obtain P' where PTrans:"P ⟼ a<νx> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: elim)
from PTrans xFreshR have "P ∥ R ⟼ a<νx> ≺ (P' ∥ R)" by(rule Early_Semantics.Par1B)
moreover from P'RelQ' RRel'T have "(P' ∥ R, Q' ∥ S) ∈ Rel''" by(rule Par)
ultimately show ?case by blast
next
case(cPar2 S')
have "S ⟼ a<νx> ≺ S'" by fact
with RSimT xFreshR obtain R' where RTrans:"R ⟼ a<νx> ≺ R'" and R'Rel'T': "(R', S') ∈ Rel'"
by(blast dest: elim)
from RTrans xFreshP have ParTrans: "P ∥ R ⟼ a<νx> ≺ (P ∥ R')" by(rule Early_Semantics.Par2B)
moreover from PRelQ R'Rel'T' have "(P ∥ R', Q ∥ S') ∈ Rel''" by(rule Par)
ultimately show ?case by blast
qed
next
case(Free α QT')
have "Q ∥ S ⟼ α ≺ QT'" by fact
thus ?case
proof(induct rule: parCasesF[of _ _ _ _ _ "(P, R)"])
case(cPar1 Q')
have "Q ⟼ α ≺ Q'" by fact
with PSimQ obtain P' where PTrans: "P ⟼ α ≺ P'" and PRel: "(P', Q') ∈ Rel"
by(blast dest: elim)
from PTrans have "P ∥ R ⟼ α ≺ P' ∥ R" by(rule Early_Semantics.Par1F)
moreover from PRel RRel'T have "(P' ∥ R, Q' ∥ S) ∈ Rel''" by(rule Par)
ultimately show ?case by blast
next
case(cPar2 S')
have "S ⟼ α ≺ S'" by fact
with RSimT obtain R' where RTrans: "R ⟼ α ≺ R'" and RRel: "(R', S') ∈ Rel'"
by(blast dest: elim)
from RTrans have "P ∥ R ⟼ α ≺ P ∥ R'" by(rule Early_Semantics.Par2F)
moreover from PRelQ RRel have "(P ∥ R', Q ∥ S') ∈ Rel''" by(rule Par)
ultimately show ?case by blast
next
case(cComm1 Q' S' a b)
have "Q ⟼ a<b> ≺ Q'" by fact
with PSimQ obtain P' where PTrans: "P ⟼a<b> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: elim)
have "S ⟼ a[b] ≺ S'" by fact
with RSimT obtain R' where RTrans: "R ⟼a[b] ≺ R'" and RRel: "(R', S') ∈ Rel'"
by(blast dest: elim)
from PTrans RTrans have "P ∥ R ⟼ τ ≺ P' ∥ R'" by(rule Early_Semantics.Comm1)
moreover from P'RelQ' RRel have "(P' ∥ R', Q' ∥ S') ∈ Rel''" by(rule Par)
ultimately show ?case by blast
next
case(cComm2 Q' S' a b)
have "Q ⟼ (OutputR a b) ≺ Q'" by fact
with PSimQ obtain P' where PTrans: "P ⟼a[b] ≺ P'" and PRel: "(P', Q') ∈ Rel"
by(blast dest: elim)
have "S ⟼ a<b> ≺ S'" by fact
with RSimT obtain R' where RTrans: "R ⟼a<b> ≺ R'" and R'Rel'T': "(R', S') ∈ Rel'"
by(blast dest: elim)
from PTrans RTrans have "P ∥ R ⟼ τ ≺ P' ∥ R'" by(rule Early_Semantics.Comm2)
moreover from PRel R'Rel'T' have "(P' ∥ R', Q' ∥ S') ∈ Rel''" by(rule Par)
ultimately show ?case by blast
next
case(cClose1 Q' S' a x)
have "x ♯ (P, R)" by fact
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by simp+
have "Q ⟼ a<x> ≺ Q'" by fact
with PSimQ obtain P' where PTrans: "P ⟼a<x> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: elim)
have "S ⟼ a<νx> ≺ S'" by fact
with RSimT xFreshR obtain R' where RTrans: "R ⟼a<νx> ≺ R'" and R'Rel'T': "(R', S') ∈ Rel'"
by(blast dest: elim)
from PTrans RTrans xFreshP have "P ∥ R ⟼ τ ≺ <νx>(P' ∥ R')"
by(rule Early_Semantics.Close1)
moreover from P'RelQ' R'Rel'T' have "(<νx>(P' ∥ R'), <νx>(Q' ∥ S')) ∈ Rel''"
by(blast intro: Par Res)
ultimately show ?case by blast
next
case(cClose2 Q' S' a x)
have "x ♯ (P, R)" by fact
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by simp+
have "Q ⟼ a<νx> ≺ Q'" by fact
with PSimQ xFreshP obtain P' where PTrans: "P ⟼a<νx> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: elim)
have "S ⟼ a<x> ≺ S'" by fact
with RSimT obtain R' where RTrans: "R ⟼a<x> ≺ R'" and R'Rel'T': "(R', S') ∈ Rel'"
by(blast dest: elim)
from PTrans RTrans xFreshR have "P ∥ R ⟼ τ ≺ <νx>(P' ∥ R')"
by(rule Early_Semantics.Close2)
moreover from P'RelQ' R'Rel'T' have "(<νx>(P' ∥ R'), <νx>(Q' ∥ S')) ∈ Rel''"
by(blast intro: Par Res)
ultimately show ?case by blast
qed
qed
lemma parPres:
fixes P :: pi
and Q :: pi
and R :: pi
and a :: name
and b :: name
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes PSimQ: "P ↝[Rel] Q"
and PRelQ: "(P, Q) ∈ Rel"
and Par: "⋀S T U. (S, T) ∈ Rel ⟹ (S ∥ U, T ∥ U) ∈ Rel'"
and Res: "⋀S T x. (S, T) ∈ Rel' ⟹ (<νx>S, <νx>T) ∈ Rel'"
shows "P ∥ R ↝[Rel'] Q ∥ R"
proof -
note PSimQ
moreover have RSimR: "R ↝[Id] R" by(auto intro: reflexive)
moreover note PRelQ moreover have "(R, R) ∈ Id" by auto
moreover from Par have "⋀P Q R T. ⟦(P, Q) ∈ Rel; (R, T) ∈ Id⟧ ⟹ (P ∥ R, Q ∥ T) ∈ Rel'"
by auto
ultimately show ?thesis using Res by(rule parCompose)
qed
lemma resPres:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and x :: name
and Rel' :: "(pi × pi) set"
assumes PSimQ: "P ↝[Rel] Q"
and ResSet: "⋀(R::pi) (S::pi) (y::name). (R, S) ∈ Rel ⟹ (<νy>R, <νy>S) ∈ Rel'"
and RelRel': "Rel ⊆ Rel'"
and EqvtRel: "eqvt Rel"
and EqvtRel': "eqvt Rel'"
shows "<νx>P ↝[Rel'] <νx>Q"
proof -
from EqvtRel' show ?thesis
proof(induct rule: simCasesCont[where C = "(P, x)"])
case(Bound a y Q')
have Trans: "<νx>Q ⟼a<νy> ≺ Q'" by fact
have "y ♯ (P, x)" by fact
hence yineqx: "y ≠ x" and yFreshP: "y ♯ (P::pi)" by simp+
from Trans yineqx show ?case
proof(induct rule: resCasesB)
case(Open Q')
have QTrans: "Q ⟼(a::name)[x] ≺ Q'" by fact
with PSimQ obtain P' where PTrans: "P ⟼ a[x] ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: elim)
have "<νx>P ⟼a<νy> ≺ ([(y, x)] ∙ P')"
proof -
have aineqx: "a ≠ x" by fact
with PTrans have "<νx>P ⟼a<νx> ≺ P'" by(rule TransitionsEarly.Open)
moreover have "a<νx> ≺ P' = a<νy> ≺ ([(y, x)] ∙ P')"
proof -
from PTrans yFreshP have yFreshP': "y ♯ P'" by(force intro: freshTransition)
thus ?thesis by(simp add: alphaBoundOutput name_swap)
qed
ultimately show ?thesis by simp
qed
moreover from EqvtRel P'RelQ' RelRel' have "([(y, x)] ∙ P', [(y, x)] ∙ Q') ∈ Rel'"
by(blast intro: eqvtRelI)
ultimately show ?case by blast
next
case(Res Q')
have QTrans: "Q ⟼a<νy> ≺ Q'" by fact
with PSimQ yFreshP obtain P' where PTrans: "P ⟼a<νy> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: elim)
have xineqa: "x ≠ a" by fact
with PTrans yineqx have ResTrans: "<νx>P ⟼a<νy> ≺ (<νx>P')"
by(blast intro: ResB)
moreover from P'RelQ' have "((<νx>P'), (<νx>Q')) ∈ Rel'"
by(rule ResSet)
ultimately show "∃P'. <νx>P ⟼ a<νy> ≺ P' ∧ (P', (<νx>Q')) ∈ Rel'" by blast
qed
next
case(Free α Q')
have Trans: "<νx>Q ⟼ α ≺ Q'" by fact
have "∃c::name. c ♯ (P, Q, Q', α)" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshQ: "c ♯ Q" and cFreshAlpha: "c ♯ α" and cFreshQ': "c ♯ Q'" and cFreshP: "c ♯ P"
by(force simp add: fresh_prod)
from cFreshP have "<νx>P = <νc>([(x, c)] ∙ P)" by(simp add: alphaRes)
moreover have "∃P'.<νc>([(x, c)] ∙ P) ⟼ α ≺ P' ∧ (P', Q') ∈ Rel'"
proof -
from Trans cFreshQ have "<νc>([(x, c)] ∙ Q) ⟼α ≺ Q'" by(simp add: alphaRes)
moreover from EqvtRel PSimQ have "([(x, c)] ∙ P) ↝[Rel] ([(x, c)] ∙ Q)"
by(blast intro: eqvtI)
ultimately show ?thesis using cFreshAlpha
apply -
apply(erule resCasesF)
apply auto
by(blast intro: ResF ResSet dest: elim)
qed
ultimately show "∃P'.<νx>P ⟼ α ≺ P' ∧ (P', Q') ∈ Rel'" by auto
qed
qed
lemma resChainI:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and lst :: "name list"
assumes eqvtRel: "eqvt Rel"
and Res: "⋀R S x. (R, S) ∈ Rel ⟹ (<νx>R, <νx>S) ∈ Rel"
and PRelQ: "P ↝[Rel] Q"
shows "(resChain lst) P ↝[Rel] (resChain lst) Q"
proof -
show ?thesis
proof(induct lst)
from PRelQ show "resChain [] P ↝[Rel] resChain [] Q" by simp
next
fix a lst
assume IH: "(resChain lst P) ↝[Rel] (resChain lst Q)"
moreover from Res have "⋀P Q a. (P, Q) ∈ Rel ⟹ (<νa>P, <νa>Q) ∈ Rel"
by simp
moreover have "Rel ⊆ Rel" by simp
ultimately have "<νa>(resChain lst P) ↝[Rel] <νa>(resChain lst Q)" using eqvtRel
by(rule_tac resPres)
thus "resChain (a # lst) P ↝[Rel] resChain (a # lst) Q"
by simp
qed
qed
lemma bangPres:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
assumes PRelQ: "(P, Q) ∈ Rel"
and Sim: "⋀R S. (R, S) ∈ Rel ⟹ R ↝[Rel] S"
and eqvtRel: "eqvt Rel"
shows "!P ↝[bangRel Rel] !Q"
proof -
let ?Sim = "λP Rs. (∀a x Q'. Rs = a<νx> ≺ Q' ⟶ x ♯ P ⟶ (∃P'. P ⟼a<νx> ≺ P' ∧ (P', Q') ∈ bangRel Rel)) ∧
(∀α Q'. Rs = α ≺ Q' ⟶ (∃P'. P ⟼α ≺ P' ∧ (P', Q') ∈ bangRel Rel))"
from eqvtRel have EqvtBangRel: "eqvt(bangRel Rel)" by(rule eqvtBangRel)
{
fix Pa Rs
assume "!Q ⟼ Rs" and "(Pa, !Q) ∈ bangRel Rel"
hence "?Sim Pa Rs" using PRelQ
proof(nominal_induct avoiding: Pa P rule: bangInduct)
case(Par1B a x Q' Pa P)
have QTrans: "Q ⟼ a<νx> ≺ Q'" by fact
have "(Pa, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ Pa" by fact+
thus "?Sim Pa (a<νx> ≺ (Q' ∥ !Q))"
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" by fact
have PBRQ: "(R, !Q) ∈ bangRel Rel" by fact
have "x ♯ P ∥ R" by fact
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by simp+
show ?case
proof(auto simp add: residual.inject alpha')
from PRelQ have "P ↝[Rel] Q" by(rule Sim)
with QTrans xFreshP obtain P' where PTrans: "P ⟼ a<νx> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: elim)
from PTrans xFreshR have "P ∥ R ⟼ a<νx> ≺ (P' ∥ R)"
by(force intro: Early_Semantics.Par1B)
moreover from P'RelQ' PBRQ have "(P' ∥ R, Q' ∥ !Q) ∈ bangRel Rel" by(rule Rel.BRPar)
ultimately show "∃P'. P ∥ R ⟼a<νx> ≺ P' ∧ (P', Q' ∥ !Q) ∈ bangRel Rel" by blast
next
fix y
assume "(y::name) ♯ Q'" and "y ♯ P" and "y ♯ R" and "y ♯ Q"
from QTrans ‹y ♯ Q'› have "Q ⟼a<νy> ≺ ([(x, y)] ∙ Q')"
by(simp add: alphaBoundOutput)
moreover from PRelQ have "P ↝[Rel] Q" by(rule Sim)
ultimately obtain P' where PTrans: "P ⟼a<νy> ≺ P'" and P'RelQ': "(P', [(x, y)] ∙ Q') ∈ Rel"
using ‹y ♯ P›
by(blast dest: elim)
from PTrans ‹y ♯ R› have "P ∥ R ⟼a<νy> ≺ (P' ∥ R)" by(force intro: Early_Semantics.Par1B)
moreover from P'RelQ' PBRQ have "(P' ∥ R, ([(x, y)] ∙ Q') ∥ !Q) ∈ bangRel Rel" by(rule Rel.BRPar)
with ‹x ♯ Q› ‹y ♯ Q› have "(P' ∥ R, ([(y, x)] ∙ Q') ∥ !([(y, x)] ∙ Q)) ∈ bangRel Rel"
by(simp add: name_fresh_fresh name_swap)
ultimately show "∃P'. P ∥ R ⟼a<νy> ≺ P' ∧ (P', ([(y, x)] ∙ Q') ∥ !([(y, x)] ∙ Q)) ∈ bangRel Rel"
by blast
qed
qed
next
case(Par1F α Q' Pa P)
have QTrans: "Q ⟼α ≺ Q'" by fact
have "(Pa, Q ∥ !Q) ∈ bangRel Rel" by fact
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and BR: "(R, !Q) ∈ bangRel Rel" by fact+
show ?case
proof(auto simp add: residual.inject)
from PRelQ have "P ↝[Rel] Q" by(rule Sim)
with QTrans obtain P' where PTrans: "P ⟼ α ≺ P'" and RRel: "(P', Q') ∈ Rel"
by(blast dest: elim)
from PTrans have "P ∥ R ⟼ α ≺ P' ∥ R" by(rule TransitionsEarly.Par1F)
moreover from RRel BR have "(P' ∥ R, Q' ∥ !Q) ∈ bangRel Rel" by(rule Rel.BRPar)
ultimately show "∃P'. P ∥ R ⟼ α ≺ P' ∧ (P', Q' ∥ !Q) ∈ bangRel Rel" by blast
qed
qed
next
case(Par2B a x Q' Pa P)
hence IH: "⋀Pa. (Pa, !Q) ∈ bangRel Rel ⟹ ?Sim Pa (a<νx> ≺ Q')" by simp
have "(Pa, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ Pa" by fact+
thus "?Sim Pa (a<νx> ≺ (Q ∥ Q'))"
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBRQ: "(R, !Q) ∈ bangRel Rel" by fact+
have "x ♯ P ∥ R" by fact
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by simp+
from EqvtBangRel show "?Sim (P ∥ R) (a<νx> ≺ (Q ∥ Q'))"
proof(auto simp add: residual.inject alpha')
from RBRQ have "?Sim R (a<νx> ≺ Q')" by(rule IH)
with xFreshR obtain R' where RTrans: "R ⟼ a<νx> ≺ R'" and R'BRQ': "(R', Q') ∈ (bangRel Rel)"
by(metis elim)
from RTrans xFreshP have "P ∥ R ⟼ a<νx> ≺ (P ∥ R')" by(auto intro: Early_Semantics.Par2B)
moreover from PRelQ R'BRQ' have "(P ∥ R', Q ∥ Q') ∈ (bangRel Rel)" by(rule Rel.BRPar)
ultimately show "∃P'. P ∥ R ⟼ a<νx> ≺ P' ∧ (P', Q ∥ Q') ∈ bangRel Rel" by blast
next
fix y
assume "(y::name) ♯ Q" and "y ♯ Q'" and "y ♯ P" and "y ♯ R"
from RBRQ have "?Sim R (a<νx> ≺ Q')" by(rule IH)
with ‹y ♯ Q'› have "?Sim R (a<νy> ≺ ([(x, y)] ∙ Q'))" by(simp add: alphaBoundOutput)
with ‹y ♯ R› obtain R' where RTrans: "R ⟼ a<νy> ≺ R'" and R'BRQ': "(R', ([(x, y)] ∙ Q')) ∈ (bangRel Rel)"
by(metis elim)
from RTrans ‹y ♯ P› have "P ∥ R ⟼ a<νy> ≺ (P ∥ R')" by(auto intro: Early_Semantics.Par2B)
moreover from PRelQ R'BRQ' have "(P ∥ R', Q ∥ ([(x, y)] ∙ Q')) ∈ (bangRel Rel)" by(rule Rel.BRPar)
with ‹y ♯ Q› ‹x ♯ Q› have "(P ∥ R', ([(y, x)] ∙ Q) ∥ ([(y, x)] ∙ Q')) ∈ (bangRel Rel)"
by(simp add: name_swap name_fresh_fresh)
ultimately show "∃P'. P ∥ R ⟼ a<νy> ≺ P' ∧ (P', ([(y, x)] ∙ Q) ∥ ([(y, x)] ∙ Q')) ∈ bangRel Rel" by blast
qed
qed
next
case(Par2F α Q' Pa P)
hence IH: "⋀Pa. (Pa, !Q) ∈ bangRel Rel ⟹ ?Sim Pa (α ≺ Q')" by simp
have "(Pa, Q ∥ !Q) ∈ bangRel Rel" by fact
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBRQ: "(R, !Q) ∈ bangRel Rel" by fact+
show ?case
proof(auto simp add: residual.inject)
from RBRQ IH have "∃R'. R ⟼ α ≺ R' ∧ (R', Q') ∈ bangRel Rel"
by(metis elim)
then obtain R' where RTrans: "R ⟼ α ≺ R'" and R'RelQ': "(R', Q') ∈ bangRel Rel"
by blast
from RTrans have "P ∥ R ⟼ α ≺ P ∥ R'" by(rule TransitionsEarly.Par2F)
moreover from PRelQ R'RelQ' have "(P ∥ R', Q ∥ Q') ∈ bangRel Rel" by(rule Rel.BRPar)
ultimately show " ∃P'. P ∥ R ⟼ α ≺ P' ∧ (P', Q ∥ Q') ∈ bangRel Rel" by blast
qed
qed
next
case(Comm1 a Q' b Q'' Pa P)
hence IH: "⋀Pa. (Pa, !Q) ∈ bangRel Rel ⟹ ?Sim Pa (a[b] ≺ Q'')" by simp
have QTrans: "Q ⟼a<b> ≺ Q'" by fact
have "(Pa, Q ∥ !Q) ∈ bangRel Rel" by fact
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBRQ: "(R, !Q) ∈ bangRel Rel" by fact+
show ?case
proof(auto simp add: residual.inject)
from PRelQ have "P ↝[Rel] Q" by(rule Sim)
with QTrans obtain P' where PTrans: "P ⟼ a<b> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: elim)
from IH RBRQ have RTrans: "∃R'. R ⟼ a[b] ≺ R' ∧ (R', Q'') ∈ bangRel Rel"
by(metis elim)
then obtain R' where RTrans: "R ⟼ a[b] ≺ R'" and R'RelQ'': "(R', Q'') ∈ bangRel Rel"
by blast
from PTrans RTrans have "P ∥ R ⟼τ ≺ P' ∥ R'" by(rule TransitionsEarly.Comm1)
moreover from P'RelQ' R'RelQ'' have "(P' ∥ R', Q' ∥ Q'') ∈ bangRel Rel" by(rule Rel.BRPar)
ultimately show "∃P'. P ∥ R ⟼ τ ≺ P' ∧ (P', Q' ∥ Q'') ∈ bangRel Rel" by blast
qed
qed
next
case(Comm2 a b Q' Q'')
hence IH: "⋀Pa. (Pa, !Q) ∈ bangRel Rel ⟹ ?Sim Pa (a<b> ≺ Q'')" by simp
have QTrans: "Q ⟼ a[b] ≺ Q'" by fact
have "(Pa, Q ∥ !Q) ∈ bangRel Rel" by fact
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBRQ: "(R, !Q) ∈ bangRel Rel" by fact+
show ?case
proof(auto simp add: residual.inject)
from PRelQ have "P ↝[Rel] Q" by(rule Sim)
with QTrans obtain P' where PTrans: "P ⟼ a[b] ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: elim)
from IH RBRQ have RTrans: "∃R'. R ⟼ a<b> ≺ R' ∧ (R', Q'') ∈ bangRel Rel"
by(metis elim)
then obtain R' where RTrans: "R ⟼ a<b> ≺ R'" and R'RelQ'': "(R', Q'') ∈ bangRel Rel"
by blast
from PTrans RTrans have "P ∥ R ⟼ τ ≺ P' ∥ R'" by(rule TransitionsEarly.Comm2)
moreover from P'RelQ' R'RelQ'' have "(P' ∥ R', Q' ∥ Q'') ∈ bangRel Rel" by(rule Rel.BRPar)
ultimately show "∃P'. P ∥ R ⟼ τ ≺ P' ∧ (P', Q' ∥ Q'') ∈ bangRel Rel" by blast
qed
qed
next
case(Close1 a x Q' Q'' Pa P)
hence IH: "⋀Pa. (Pa, !Q) ∈ bangRel Rel ⟶ ?Sim Pa (a<νx> ≺ Q'')" by simp
have QTrans: "Q ⟼ a<x> ≺ Q'" by fact
have xFreshQ: "x ♯ Q" by fact
have "(Pa, Q ∥ !Q) ∈ bangRel Rel" by fact
moreover have xFreshPa: "x ♯ Pa" by fact
ultimately show ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBRQ: "(R, !Q) ∈ bangRel Rel" by fact+
have "x ♯ P ∥ R" by fact
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by simp+
show ?case
proof(auto simp add: residual.inject)
from PRelQ have "P ↝[Rel] Q" by(rule Sim)
with QTrans xFreshP obtain P' where PTrans: "P ⟼a<x> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: elim)
from RBRQ xFreshR IH have "∃R'. R ⟼a<νx> ≺ R' ∧ (R', Q'') ∈ bangRel Rel"
by(metis elim)
then obtain R' where RTrans: "R ⟼a<νx> ≺ R'" and R'RelQ'': "(R', Q'') ∈ bangRel Rel"
by blast
from PTrans RTrans xFreshP have "P ∥ R ⟼τ ≺ <νx>(P' ∥ R')"
by(rule Early_Semantics.Close1)
moreover from P'RelQ' R'RelQ'' have "(<νx>(P' ∥ R'), <νx>(Q' ∥ Q'')) ∈ bangRel Rel"
by(force intro: Rel.BRPar BRRes)
ultimately show "∃P'. P ∥ R ⟼ τ ≺ P' ∧ (P', <νx>(Q' ∥ Q'')) ∈ bangRel Rel" by blast
qed
qed
next
case(Close2 a x Q' Q'' Pa P)
hence IH: "⋀Pa. (Pa, !Q) ∈ bangRel Rel ⟹ ?Sim Pa (a<x> ≺ Q'')" by simp
have QTrans: "Q ⟼ a<νx> ≺ Q'" by fact
have xFreshQ: "x ♯ Q" by fact
have "(Pa, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ Pa" by fact+
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBRQ: "(R, !Q) ∈ bangRel Rel" by fact+
have "x ♯ P ∥ R" by fact
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by simp+
show ?case
proof(auto simp add: residual.inject)
from PRelQ have "P ↝[Rel] Q" by(rule Sim)
with QTrans xFreshP obtain P' where PTrans: "P ⟼a<νx> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: elim)
from RBRQ IH have "∃R'. R ⟼a<x> ≺ R' ∧ (R', Q'') ∈ bangRel Rel"
by auto
then obtain R' where RTrans: "R ⟼ a<x> ≺ R'" and R'RelQ'': "(R', Q'') ∈ bangRel Rel"
by blast
from PTrans RTrans xFreshR have "P ∥ R ⟼ τ ≺ <νx>(P' ∥ R')"
by(rule Early_Semantics.Close2)
moreover from P'RelQ' R'RelQ'' have "(<νx>(P' ∥ R'), <νx>(Q' ∥ Q'')) ∈ bangRel Rel"
by(force intro: Rel.BRPar BRRes)
ultimately show "∃P'. P ∥ R ⟼ τ ≺ P' ∧ (P', <νx>(Q' ∥ Q'')) ∈ bangRel Rel" by blast
qed
qed
next
case(Bang Rs Pa P)
hence IH: "⋀Pa. (Pa, Q ∥ !Q) ∈ bangRel Rel ⟹ ?Sim Pa Rs" by simp
have "(Pa, !Q) ∈ bangRel Rel" by fact
thus ?case
proof(induct rule: BRBangCases)
case(BRBang P)
have PRelQ: "(P, Q) ∈ Rel" by fact
hence "(!P, !Q) ∈ bangRel Rel" by(rule Rel.BRBang)
with PRelQ have "(P ∥ !P, Q ∥ !Q) ∈ bangRel Rel" by(rule BRPar)
with IH have "?Sim (P ∥ !P) Rs" by simp
thus ?case by(force intro: TransitionsEarly.Bang)
qed
qed
}
moreover from PRelQ have "(!P, !Q) ∈ bangRel Rel" by(rule BRBang)
ultimately show ?thesis by(auto simp add: strongSimEarly_def)
qed
end
Theory Strong_Early_Bisim_Pres
theory Strong_Early_Bisim_Pres
imports Strong_Early_Bisim Strong_Early_Sim_Pres
begin
lemma tauPres:
fixes P :: pi
and Q :: pi
assumes "P ∼ Q"
shows "τ.(P) ∼ τ.(Q)"
proof -
let ?X = "{(τ.(P), τ.(Q)) | P Q. P ∼ Q}"
from ‹P ∼ Q› have "(τ.(P), τ.(Q)) ∈ ?X" by auto
thus ?thesis
by(coinduct rule: bisimCoinduct) (auto intro: tauPres dest: bisimE)
qed
lemma inputPres:
fixes P :: pi
and Q :: pi
and a :: name
and x :: name
assumes PSimQ: "∀y. P[x::=y] ∼ Q[x::=y]"
shows "a<x>.P ∼ a<x>.Q"
proof -
let ?X = "{(a<x>.P, a<x>.Q) | a x P Q. ∀y. P[x::=y] ∼ Q[x::=y]}"
{
fix axP axQ p
assume "(axP, axQ) ∈ ?X"
then obtain a x P Q where A: "∀y. P[x::=y] ∼ Q[x::=y]" and B: "axP = a<x>.P" and C: "axQ = a<x>.Q"
by auto
have "⋀y. ((p::name prm) ∙ P)[(p ∙ x)::=y] ∼ (p ∙ Q)[(p ∙ x)::=y]"
proof -
fix y
from A have "P[x::=(rev p ∙ y)] ∼ Q[x::=(rev p ∙ y)]"
by blast
hence "(p ∙ (P[x::=(rev p ∙ y)])) ∼ p ∙ (Q[x::=(rev p ∙ y)])"
by(rule bisimClosed)
thus "(p ∙ P)[(p ∙ x)::=y] ∼ (p ∙ Q)[(p ∙ x)::=y]"
by(simp add: eqvts pt_pi_rev[OF pt_name_inst, OF at_name_inst])
qed
hence "((p::name prm) ∙ axP, p ∙ axQ) ∈ ?X" using B C
by auto
}
hence "eqvt ?X" by(simp add: eqvt_def)
from PSimQ have "(a<x>.P, a<x>.Q) ∈ ?X" by auto
thus ?thesis
proof(coinduct rule: bisimCoinduct)
case(cSim P Q)
thus ?case using ‹eqvt ?X›
by(force intro: inputPres)
next
case(cSym P Q)
thus ?case
by(blast dest: bisimE)
qed
qed
lemma outputPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
assumes "P ∼ Q"
shows "a{b}.P ∼ a{b}.Q"
proof -
let ?X = "{(a{b}.P, a{b}.Q) | a b P Q. P ∼ Q}"
from ‹P ∼ Q› have "(a{b}.P, a{b}.Q) ∈ ?X" by auto
thus ?thesis
by(coinduct rule: bisimCoinduct) (blast intro: outputPres dest: bisimE)+
qed
lemma matchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
assumes "P ∼ Q"
shows "[a⌢b]P ∼ [a⌢b]Q"
proof -
let ?X = "{x. ∃P Q a b. P ∼ Q ∧ x = ([a⌢b]P, [a⌢b]Q)}"
from assms have "([a⌢b]P, [a⌢b]Q) ∈ ?X" by blast
thus ?thesis
by(coinduct rule: bisimCoinduct) (blast intro: matchPres dest: bisimE)+
qed
lemma mismatchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
assumes "P ∼ Q"
shows "[a≠b]P ∼ [a≠b]Q"
proof -
let ?X = "{x. ∃P Q a b. P ∼ Q ∧ x = ([a≠b]P, [a≠b]Q)}"
from assms have "([a≠b]P, [a≠b]Q) ∈ ?X" by blast
thus ?thesis
by(coinduct rule: bisimCoinduct) (blast intro: mismatchPres dest: bisimE)+
qed
lemma sumPres:
fixes P :: pi
and Q :: pi
and R :: pi
assumes "P ∼ Q"
shows "P ⊕ R ∼ Q ⊕ R"
proof -
let ?X = "{(P ⊕ R, Q ⊕ R) | P Q R. P ∼ Q}"
from assms have "(P ⊕ R, Q ⊕ R) ∈ ?X" by blast
thus ?thesis
by(coinduct rule: bisimCoinduct) (auto dest: bisimE intro: reflexive sumPres)
qed
lemma resPres:
fixes P :: pi
and Q :: pi
and x :: name
assumes "P ∼ Q"
shows "<νx>P ∼ <νx>Q"
proof -
let ?X = "{x. ∃P Q. P ∼ Q ∧ (∃a. x = (<νa>P, <νa>Q))}"
from assms have "(<νx>P, <νx>Q) ∈ ?X" by blast
thus ?thesis
proof(coinduct rule: bisimCoinduct)
case(cSim xP xQ)
moreover {
fix P Q a
assume "P ∼ Q"
hence "P ↝[bisim] Q" by(rule bisimE)
moreover have "⋀P Q a. P ∼ Q ⟹ (<νa>P, <νa>Q) ∈ ?X ∪ bisim" by blast
moreover have "bisim ⊆ ?X ∪ bisim" by blast
moreover have "eqvt bisim" by(rule eqvt)
moreover have "eqvt (?X ∪ bisim)" using eqvts
by(auto simp add: eqvt_def) blast
ultimately have "<νa>P ↝[(?X ∪ bisim)] <νa>Q"
by(rule Strong_Early_Sim_Pres.resPres)
}
ultimately show ?case by auto
next
case(cSym xP xQ)
thus ?case by(auto dest: bisimE)
qed
qed
lemma parPres:
fixes P :: pi
and Q :: pi
and R :: pi
and T :: pi
assumes "P ∼ Q"
shows "P ∥ R ∼ Q ∥ R"
proof -
let ?X = "{(resChain lst (P ∥ R), resChain lst (Q ∥ R)) | lst P Q R. P ∼ Q}"
have BC: "⋀P Q. P ∥ Q = resChain [] (P ∥ Q)" by auto
from assms have "(P ∥ R, Q ∥ R) ∈ ?X" by(blast intro: BC)
thus ?thesis
proof(coinduct rule: bisimWeakCoinduct)
case(cSim PR QR)
moreover {
fix lst P Q R
assume "P ∼ Q"
have "eqvt ?X" using eqvts by(auto simp add: eqvt_def) blast
moreover have Res: "⋀P Q x. (P, Q) ∈ ?X ⟹ (<νx>P, <νx>Q) ∈ ?X"
by(auto, rule_tac x="x#lst" in exI) auto
moreover {
from ‹P ∼ Q› have "P ↝[bisim] Q" by(rule bisimE)
moreover note ‹P ∼ Q›
moreover have "⋀P Q R. P ∼ Q ⟹ (P ∥ R, Q ∥ R) ∈ ?X"
by(blast intro: BC)
ultimately have "P ∥ R ↝[?X] Q ∥ R" using Res
by(rule parPres)
}
ultimately have "resChain lst (P ∥ R) ↝[?X] resChain lst (Q ∥ R)"
by(rule resChainI)
}
ultimately show ?case by auto
next
case(cSym P Q)
thus ?case by(auto dest: bisimE)
qed
qed
lemma bangRelBisimE:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
assumes A: "(P, Q) ∈ bangRel Rel"
and Sym: "⋀P Q. (P, Q) ∈ Rel ⟹ (Q, P) ∈ Rel"
shows "(Q, P) ∈ bangRel Rel"
proof -
from A show ?thesis
proof(induct)
fix P Q
assume "(P, Q) ∈ Rel"
hence "(Q, P) ∈ Rel" by(rule Sym)
thus "(!Q, !P) ∈ bangRel Rel" by(rule BRBang)
next
fix P Q R T
assume RRelT: "(R, T) ∈ Rel"
assume IH: "(Q, P) ∈ bangRel Rel"
from RRelT have "(T, R) ∈ Rel" by(rule Sym)
thus "(T ∥ Q, R ∥ P) ∈ bangRel Rel" using IH by(rule BRPar)
next
fix P Q a
assume "(Q, P) ∈ bangRel Rel"
thus "(<νa>Q, <νa>P) ∈ bangRel Rel" by(rule BRRes)
qed
qed
lemma bangPres:
fixes P :: pi
and Q :: pi
assumes PBiSimQ: "P ∼ Q"
shows "!P ∼ !Q"
proof -
let ?X = "bangRel bisim"
from PBiSimQ have "(!P, !Q) ∈ ?X" by(rule BRBang)
thus ?thesis
proof(coinduct rule: bisimWeakCoinduct)
case(cSim bP bQ)
{
fix P Q
assume "(P, Q) ∈ ?X"
hence "P ↝[?X] Q"
proof(induct)
fix P Q
assume "P ∼ Q"
thus "!P ↝[?X] !Q" using bisimE(1) eqvt
by(rule Strong_Early_Sim_Pres.bangPres)
next
fix P Q R T
assume RBiSimT: "R ∼ T"
assume PBangRelQ: "(P, Q) ∈ ?X"
assume PSimQ: "P ↝[?X] Q"
from RBiSimT have "R ↝[bisim] T" by(blast dest: bisimE)
thus "R ∥ P ↝[?X] T ∥ Q" using PSimQ RBiSimT PBangRelQ BRPar BRRes eqvt eqvtBangRel
by(blast intro: Strong_Early_Sim_Pres.parCompose)
next
fix P Q a
assume "P ↝[?X] Q"
moreover from eqvtBangRel eqvt have "eqvt ?X" by blast
ultimately show "<νa>P ↝[?X] <νa>Q" using BRRes by(blast intro: Strong_Early_Sim_Pres.resPres)
qed
}
with ‹(bP, bQ) ∈ ?X› show ?case by blast
next
case(cSym bP bQ)
thus ?case by(metis bangRelSymetric bisimE)
qed
qed
end
Theory Strong_Early_Bisim_Subst_Pres
theory Strong_Early_Bisim_Subst_Pres
imports Strong_Early_Bisim_Subst Strong_Early_Bisim_Pres
begin
lemma tauPres:
fixes P :: pi
and Q :: pi
assumes "P ∼⇧s Q"
shows "τ.(P) ∼⇧s τ.(Q)"
using assms
by(force simp add: substClosed_def intro: Strong_Early_Bisim_Pres.tauPres)
lemma inputPres:
fixes P :: pi
and Q :: pi
and a :: name
and x :: name
assumes "P ∼⇧s Q"
shows "a<x>.P ∼⇧s a<x>.Q"
proof(auto simp add: substClosed_def)
fix σ :: "(name × name) list"
{
fix P Q a x σ
assume "P ∼⇧s Q"
then have "P[<σ>] ∼⇧s Q[<σ>]" by(rule partUnfold)
then have "∀y. (P[<σ>])[x::=y] ∼ (Q[<σ>])[x::=y]"
apply(auto simp add: substClosed_def)
by(erule_tac x="[(x, y)]" in allE) auto
moreover assume "x ♯ σ"
ultimately have "(a<x>.P)[<σ>] ∼ (a<x>.Q)[<σ>]"
by(force intro: Strong_Early_Bisim_Pres.inputPres)
}
note Goal = this
obtain y::name where "y ♯ P" and "y ♯ Q" and "y ♯ σ"
by(generate_fresh "name") auto
from ‹P ∼⇧s Q› have "([(x, y)] ∙ P) ∼⇧s ([(x, y)] ∙ Q)" by(rule eqvtI)
hence "(a<y>.([(x, y)] ∙ P))[<σ>] ∼ (a<y>.([(x, y)] ∙ Q))[<σ>]" using ‹y ♯ σ› by(rule Goal)
moreover from ‹y ♯ P› ‹y ♯ Q› have "a<x>.P = a<y>.([(x, y)] ∙ P)" and "a<x>.Q = a<y>.([(x, y)] ∙ Q)"
by(simp add: alphaInput)+
ultimately show "(a<x>.P)[<σ>] ∼ (a<x>.Q)[<σ>]" by simp
qed
lemma outputPres:
fixes P :: pi
and Q :: pi
assumes "P ∼⇧s Q"
shows "a{b}.P ∼⇧s a{b}.Q"
using assms
by(force simp add: substClosed_def intro: Strong_Early_Bisim_Pres.outputPres)
lemma matchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
assumes "P ∼⇧s Q"
shows "[a⌢b]P ∼⇧s [a⌢b]Q"
using assms
by(force simp add: substClosed_def intro: Strong_Early_Bisim_Pres.matchPres)
lemma mismatchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
assumes "P ∼⇧s Q"
shows "[a≠b]P ∼⇧s [a≠b]Q"
using assms
by(force simp add: substClosed_def intro: Strong_Early_Bisim_Pres.mismatchPres)
lemma sumPres:
fixes P :: pi
and Q :: pi
and R :: pi
assumes "P ∼⇧s Q"
shows "P ⊕ R ∼⇧s Q ⊕ R"
using assms
by(force simp add: substClosed_def intro: Strong_Early_Bisim_Pres.sumPres)
lemma parPres:
fixes P :: pi
and Q :: pi
and R :: pi
assumes "P ∼⇧s Q"
shows "P ∥ R ∼⇧s Q ∥ R"
using assms
by(force simp add: substClosed_def intro: Strong_Early_Bisim_Pres.parPres)
lemma resPres:
fixes P :: pi
and Q :: pi
and x :: name
assumes PeqQ: "P ∼⇧s Q"
shows "<νx>P ∼⇧s <νx>Q"
proof(auto simp add: substClosed_def)
fix s::"(name × name) list"
have Res: "⋀P Q x s. ⟦P[<s>] ∼ Q[<s>]; x ♯ s⟧ ⟹ (<νx>P)[<s>] ∼ (<νx>Q)[<s>]"
by(force intro: Strong_Early_Bisim_Pres.resPres)
have "∃c::name. c ♯ (P, Q, s)" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshP: "c ♯ P" and cFreshQ: "c ♯ Q" and cFreshs: "c ♯ s"
by(force simp add: fresh_prod)
from PeqQ have "P[<([(x, c)] ∙ s)>] ∼ Q[<([(x, c)] ∙ s)>]" by(simp add: substClosed_def)
hence "([(x, c)] ∙ P[<([(x, c)] ∙ s)>]) ∼ ([(x, c)] ∙ Q[<([(x, c)] ∙ s)>])" by(rule Strong_Early_Bisim.bisimClosed)
hence "([(x, c)] ∙ P)[<s>] ∼ ([(x, c)] ∙ Q)[<s>]" by simp
hence "(<νc>([(x, c)] ∙ P))[<s>] ∼ (<νc>([(x, c)] ∙ Q))[<s>]" using cFreshs by(rule Res)
moreover from cFreshP cFreshQ have "<νx>P = <νc>([(x, c)] ∙ P)" and "<νx>Q = <νc>([(x, c)] ∙ Q)"
by(simp add: alphaRes)+
ultimately show "(<νx>P)[<s>] ∼ (<νx>Q)[<s>]" by simp
qed
lemma bangPres:
fixes P :: pi
and Q :: pi
assumes "P ∼⇧s Q"
shows "!P ∼⇧s !Q"
using assms
by(force simp add: substClosed_def intro: Strong_Early_Bisim_Pres.bangPres)
end
Theory Early_Tau_Chain
theory Early_Tau_Chain
imports Early_Semantics
begin
abbreviation tauChain :: "pi ⇒ pi ⇒ bool" ("_ ⟹⇩τ _" [80, 80] 80)
where "P ⟹⇩τ P' ≡ (P, P') ∈ {(P, P') | P P'. P ⟼τ ≺ P'}^*"
lemma tauActTauChain:
fixes P :: pi
and P' :: pi
assumes "P ⟼τ ≺ P'"
shows "P ⟹⇩τ P'"
using assms
by auto
lemma tauChainAddTau[intro]:
fixes P :: pi
and P' :: pi
and P'' :: pi
shows "P ⟹⇩τ P' ⟹ P' ⟼τ ≺ P'' ⟹ P ⟹⇩τ P''"
and "P ⟼τ ≺ P' ⟹ P' ⟹⇩τ P'' ⟹ P ⟹⇩τ P''"
by(auto dest: tauActTauChain)
lemma tauChainInduct[consumes 1, case_names id ih]:
fixes P :: pi
and P' :: pi
assumes "P ⟹⇩τ P'"
and "F P"
and "⋀P'' P'''. ⟦P ⟹⇩τ P''; P'' ⟼τ ≺ P'''; F P''⟧ ⟹ F P'''"
shows "F P'"
using assms
by(drule_tac rtrancl_induct) auto
lemma eqvtChainI:
fixes P :: pi
and P' :: pi
and perm :: "name prm"
assumes "P ⟹⇩τ P'"
shows "(perm ∙ P) ⟹⇩τ (perm ∙ P')"
using assms
proof(induct rule: tauChainInduct)
case id
thus ?case by simp
next
case(ih P'' P''')
have "P ⟹⇩τ P''" and "P'' ⟼ τ ≺ P'''" by fact+
hence "(perm ∙ P'') ⟼τ ≺ (perm ∙ P''')" by(drule_tac TransitionsEarly.eqvt) auto
moreover have "(perm ∙ P) ⟹⇩τ (perm ∙ P'')" by fact
ultimately show ?case by(force dest: tauActTauChain)
qed
lemma eqvtChainE:
fixes perm :: "name prm"
and P :: pi
and P' :: pi
assumes Trans: "(perm ∙ P) ⟹⇩τ (perm ∙ P')"
shows "P ⟹⇩τ P'"
proof -
have "rev perm ∙ (perm ∙ P) = P" by(simp add: pt_rev_pi[OF pt_name_inst, OF at_name_inst])
moreover have "rev perm ∙ (perm ∙ P') = P'" by(simp add: pt_rev_pi[OF pt_name_inst, OF at_name_inst])
ultimately show ?thesis using assms
by(drule_tac perm="rev perm" in eqvtChainI, simp)
qed
lemma eqvtChainEq:
fixes P :: pi
and P' :: pi
and perm :: "name prm"
shows "P ⟹⇩τ P' = (perm ∙ P) ⟹⇩τ (perm ∙ P')"
by(blast intro: eqvtChainE eqvtChainI)
lemma freshChain:
fixes P :: pi
and P' :: pi
and x :: name
assumes "P ⟹⇩τ P'"
and "x ♯ P"
shows "x ♯ P'"
using assms
proof(induct rule: tauChainInduct)
case id
thus ?case by simp
next
case(ih P' P'')
have "x ♯ P" and "x ♯ P ⟹ x ♯ P'" by fact+
hence "x ♯ P'" by simp
moreover have "P' ⟼ τ ≺ P''" by fact
ultimately show ?case by(force intro: freshTransition)
qed
lemma matchChain:
fixes b :: name
and P :: pi
and P' :: pi
assumes "P ⟹⇩τ P'"
and "P ≠ P'"
shows "[b⌢b]P ⟹⇩τ P'"
using assms
proof(induct rule: tauChainInduct)
case id
thus ?case by simp
next
case(ih P'' P''')
have P''TransP''': "P'' ⟼τ ≺ P'''" by fact
show "[b⌢b]P ⟹⇩τ P'''"
proof(cases "P = P''")
assume "P=P''"
moreover with P''TransP''' have "[b⌢b]P ⟼τ ≺ P'''" by(force intro: Match)
thus "[b⌢b]P ⟹⇩τ P'''" by(rule tauActTauChain)
next
assume "P ≠ P''"
moreover have "P ≠ P'' ⟹ [b⌢b]P ⟹⇩τ P''" by fact
ultimately show "[b⌢b]P ⟹⇩τ P'''" using P''TransP''' by(blast)
qed
qed
lemma mismatchChain:
fixes a :: name
and b :: name
and P :: pi
and P' :: pi
assumes PChain: "P ⟹⇩τ P'"
and aineqb: "a ≠ b"
and PineqP': "P ≠ P'"
shows "[a≠b]P ⟹⇩τ P'"
proof -
from PChain PineqP' show ?thesis
proof(induct rule: tauChainInduct)
case id
thus ?case by simp
next
case(ih P'' P''')
have P''TransP''': "P'' ⟼τ ≺ P'''" by fact
show "[a≠b]P ⟹⇩τ P'''"
proof(cases "P = P''")
assume "P=P''"
moreover with aineqb P''TransP''' have "[a≠b]P ⟼τ ≺ P'''" by(force intro: Mismatch)
thus "[a≠b]P ⟹⇩τ P'''" by(rule tauActTauChain)
next
assume "P ≠ P''"
moreover have "P ≠ P'' ⟹ [a≠b]P ⟹⇩τ P''" by fact
ultimately show "[a≠b]P ⟹⇩τ P'''" using P''TransP''' by(blast)
qed
qed
qed
lemma sum1Chain:
fixes P :: pi
and P' :: pi
and Q :: pi
assumes "P ⟹⇩τ P'"
and "P ≠ P'"
shows "P ⊕ Q ⟹⇩τ P'"
using assms
proof(induct rule: tauChainInduct)
case id
thus ?case by simp
next
case(ih P'' P''')
have P''TransP''': "P'' ⟼τ ≺ P'''" by fact
show "P ⊕ Q ⟹⇩τ P'''"
proof(cases "P = P''")
assume "P=P''"
moreover with P''TransP''' have "P ⊕ Q ⟼τ ≺ P'''" by(force intro: Sum1)
thus "P ⊕ Q ⟹⇩τ P'''" by(force intro: tauActTauChain)
next
assume "P ≠ P''"
moreover have "P ≠ P'' ⟹ P ⊕ Q ⟹⇩τ P''" by fact
ultimately show "P ⊕ Q ⟹⇩τ P'''" using P''TransP''' by(force dest: tauActTauChain)
qed
qed
lemma sum2Chain:
fixes P :: pi
and Q :: pi
and Q' :: pi
assumes "Q ⟹⇩τ Q'"
and "Q ≠ Q'"
shows "P ⊕ Q ⟹⇩τ Q'"
using assms
proof(induct rule: tauChainInduct)
case id
thus ?case by simp
next
case(ih Q'' Q''')
have Q''TransQ''': "Q'' ⟼τ ≺ Q'''" by fact
show "P ⊕ Q ⟹⇩τ Q'''"
proof(cases "Q = Q''")
assume "Q=Q''"
moreover with Q''TransQ''' have "P ⊕ Q ⟼τ ≺ Q'''" by(force intro: Sum2)
thus "P ⊕ Q ⟹⇩τ Q'''" by(force intro: tauActTauChain)
next
assume "Q ≠ Q''"
moreover have "Q ≠ Q'' ⟹ P ⊕ Q ⟹⇩τ Q''" by fact
ultimately show "P ⊕ Q ⟹⇩τ Q'''" using Q''TransQ''' by blast
qed
qed
lemma Par1Chain:
fixes P :: pi
and P' :: pi
and Q :: pi
assumes "P ⟹⇩τ P'"
shows "P ∥ Q ⟹⇩τ P' ∥ Q"
using assms
proof(induct rule: tauChainInduct)
case id
thus ?case by simp
next
case(ih P'' P')
have P''TransP': "P'' ⟼τ ≺ P'" by fact
have IH: "P ∥ Q ⟹⇩τ P'' ∥ Q" by fact
have "P'' ∥ Q ⟼τ ≺ P' ∥ Q" using P''TransP' by(force intro: Par1F)
thus "P ∥ Q ⟹⇩τ P' ∥ Q" using IH by(force dest: tauActTauChain)
qed
lemma Par2Chain:
fixes P :: pi
and Q :: pi
and Q' :: pi
assumes "Q ⟹⇩τ Q'"
shows "P ∥ Q ⟹⇩τ P ∥ Q'"
using assms
proof(induct rule: tauChainInduct)
case id
thus ?case by simp
next
case(ih Q'' Q')
have Q''TransQ': "Q'' ⟼τ ≺ Q'" by fact
have IH: "P ∥ Q ⟹⇩τ P ∥ Q''" by fact
have "P ∥ Q'' ⟼τ ≺ P ∥ Q'" using Q''TransQ' by(force intro: Par2F)
thus "P ∥ Q ⟹⇩τ P ∥ Q'" using IH by(force dest: tauActTauChain)
qed
lemma chainPar:
fixes P :: pi
and P' :: pi
and Q :: pi
and Q' :: pi
assumes "P ⟹⇩τ P'"
and "Q ⟹⇩τ Q'"
shows "P ∥ Q ⟹⇩τ P' ∥ Q'"
proof -
from ‹P ⟹⇩τ P'› have "P ∥ Q ⟹⇩τ P' ∥ Q" by(rule Par1Chain)
moreover from ‹Q ⟹⇩τ Q'› have "P' ∥ Q ⟹⇩τ P' ∥ Q'" by(rule Par2Chain)
ultimately show ?thesis by auto
qed
lemma ResChain:
fixes P :: pi
and P' :: pi
and a :: name
assumes "P ⟹⇩τ P'"
shows "<νa>P ⟹⇩τ <νa>P'"
using assms
proof(induct rule: tauChainInduct)
case id
thus ?case by simp
next
case(ih P'' P''')
have "P'' ⟼τ ≺ P'''" by fact
hence "<νa>P'' ⟼τ ≺ <νa>P'''" by(force intro: ResF)
moreover have "<νa>P ⟹⇩τ <νa>P''" by fact
ultimately show ?case by(force dest: tauActTauChain)
qed
lemma substChain:
fixes P :: pi
and x :: name
and b :: name
and P' :: pi
assumes PTrans: "P[x::=b] ⟹⇩τ P'"
shows "P[x::=b] ⟹⇩τ P'[x::=b]"
proof(cases "x=b")
assume "x = b"
with PTrans show ?thesis by simp
next
assume "x ≠ b"
hence "x ♯ P[x::=b]" by(simp add: fresh_fact2)
with PTrans have "x ♯ P'" by(force intro: freshChain)
hence "P' = P'[x::=b]" by(simp add: forget)
with PTrans show ?thesis by simp
qed
lemma bangChain:
fixes P :: pi
and P' :: pi
assumes PTrans: "P ∥ !P ⟹⇩τ P'"
and P'ineq: "P' ≠ P ∥ !P"
shows "!P ⟹⇩τ P'"
using assms
proof(induct rule: tauChainInduct)
case id
thus ?case by simp
next
case(ih P' P'')
show ?case
proof(cases "P' = P ∥ !P")
case True
from ‹P' ⟼τ ≺ P''› ‹P' = P ∥ !P› have "!P ⟼τ ≺ P''" by(blast intro: Bang)
thus ?thesis by auto
next
case False
from ‹P' ≠ P ∥ !P› have "!P ⟹⇩τ P'" by(rule ih)
with ‹P' ⟼τ ≺ P''› show ?thesis by(auto dest: tauActTauChain)
qed
qed
end
Theory Weak_Early_Step_Semantics
theory Weak_Early_Step_Semantics
imports Early_Tau_Chain
begin
lemma inputSupportDerivative:
assumes "P ⟼a<x> ≺ P'"
shows "(supp P') - {x} ⊆ supp P"
using assms
apply(nominal_induct rule: inputInduct)
apply(auto simp add: pi.supp abs_supp supp_atm)
apply(rule ccontr)
apply(simp add: fresh_def[symmetric])
apply(drule_tac fresh_fact1)
apply(rotate_tac 4)
apply assumption
apply(simp add: fresh_def)
apply force
apply(case_tac "x ♯ P")
apply(drule_tac fresh_fact1)
apply(rotate_tac 2)
apply assumption
apply(simp add: fresh_def)
apply force
apply(rotate_tac 2)
apply(drule_tac fresh_fact2)
apply(simp add: fresh_def)
by force
lemma outputSupportDerivative:
fixes P :: pi
and a :: name
and b :: name
and P' :: pi
assumes "P ⟼a[b] ≺ P'"
shows "(supp P') ⊆ ((supp P)::name set)"
using assms
by(nominal_induct rule: outputInduct) (auto simp add: pi.supp abs_supp)
lemma boundOutputSupportDerivative:
assumes "P ⟼a<νx> ≺ P'"
and "x ♯ P"
shows "(supp P') - {x} ⊆ supp P"
using assms
by(nominal_induct rule: boundOutputInduct) (auto simp add: pi.supp abs_supp supp_atm dest: outputSupportDerivative)
lemma tauSupportDerivative:
assumes "P ⟼τ ≺ P'"
shows "((supp P')::name set) ⊆ supp P"
using assms
proof(nominal_induct rule: tauInduct)
case(Tau P)
thus ?case by(force simp add: pi.supp)
next
case(Match P)
thus ?case by(force simp add: pi.supp)
next
case(Mismatch P)
thus ?case by(force simp add: pi.supp)
next
case(Sum1 P)
thus ?case by(force simp add: pi.supp)
next
case(Sum2 P)
thus ?case by(force simp add: pi.supp)
next
case(Par1 P)
thus ?case by(force simp add: pi.supp)
next
case(Par2 P)
thus ?case by(force simp add: pi.supp)
next
case(Comm1 P a b P' Q Q')
from ‹P ⟼a<b> ≺ P'› have "(supp P') - {b} ⊆ supp P" by(rule inputSupportDerivative)
moreover from ‹Q ⟼ a[b] ≺ Q'› have "((supp Q')::name set) ⊆ supp Q" by(rule outputSupportDerivative)
moreover from ‹Q ⟼ a[b] ≺ Q'› have "b ∈ supp Q"
by(nominal_induct rule: outputInduct) (auto simp add: pi.supp abs_supp supp_atm)
ultimately show ?case by(auto simp add: pi.supp)
next
case(Comm2 P a b P' Q Q')
from ‹P ⟼ a[b] ≺ P'› have "((supp P')::name set) ⊆ supp P" by(rule outputSupportDerivative)
moreover from ‹Q ⟼a<b> ≺ Q'› have "(supp Q') - {b} ⊆ supp Q" by(rule inputSupportDerivative)
moreover from ‹P ⟼ a[b] ≺ P'› have "b ∈ supp P"
by(nominal_induct rule: outputInduct) (auto simp add: pi.supp abs_supp supp_atm)
ultimately show ?case by(auto simp add: pi.supp)
next
case(Close1 P a x P' Q Q')
thus ?case by(auto dest: inputSupportDerivative boundOutputSupportDerivative simp add: abs_supp pi.supp)
next
case(Close2 P a x P' Q Q')
thus ?case by(auto dest: inputSupportDerivative boundOutputSupportDerivative simp add: abs_supp pi.supp)
next
case(Res P P' x)
thus ?case by(force simp add: pi.supp abs_supp)
next
case(Bang P P')
thus ?case by(force simp add: pi.supp)
qed
lemma tauChainSupportDerivative:
fixes P :: pi
and P' :: pi
assumes "P ⟹⇩τ P'"
shows "((supp P')::name set) ⊆ (supp P)"
using assms
by(induct rule: tauChainInduct) (auto dest: tauSupportDerivative)
definition outputTransition :: "pi ⇒ name ⇒ name ⇒ pi ⇒ bool" ("_ ⟹_<ν_> ≺ _" [80, 80, 80, 80] 80)
where "P ⟹a<νx> ≺ P' ≡ ∃P''' P''. P ⟹⇩τ P''' ∧ P''' ⟼a<νx> ≺ P'' ∧ P'' ⟹⇩τ P'"
definition freeTransition :: "pi ⇒ freeRes⇒ pi ⇒ bool" ("_ ⟹_ ≺ _" [80, 80, 80] 80)
where "P ⟹α ≺ P' ≡ ∃P''' P''. P ⟹⇩τ P''' ∧ P''' ⟼α ≺ P'' ∧ P'' ⟹⇩τ P'"
lemma transitionI:
fixes P :: pi
and P''' :: pi
and α :: freeRes
and P'' :: pi
and P' :: pi
and a :: name
and x :: name
shows "⟦P ⟹⇩τ P'''; P''' ⟼α ≺ P''; P'' ⟹⇩τ P'⟧ ⟹ P ⟹α ≺ P'"
and "⟦P ⟹⇩τ P'''; P''' ⟼a<νx> ≺ P''; P'' ⟹⇩τ P'⟧ ⟹ P ⟹a<νx> ≺ P'"
by(auto simp add: outputTransition_def freeTransition_def)
lemma transitionE:
fixes P :: pi
and α :: freeRes
and P' :: pi
and a :: name
and x :: name
shows "P ⟹α ≺ P' ⟹ (∃P'' P'''. P ⟹⇩τ P'' ∧ P'' ⟼α ≺ P''' ∧ P''' ⟹⇩τ P')"
and "P ⟹a<νx> ≺ P' ⟹ ∃P'' P'''. P ⟹⇩τ P''' ∧ P''' ⟼a<νx> ≺ P'' ∧ P'' ⟹⇩τ P'"
by(auto simp add: outputTransition_def freeTransition_def)
lemma weakTransitionAlpha:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
and y :: name
assumes PTrans: "P ⟹a<νx> ≺ P'"
and "y ♯ P"
shows "P ⟹a<νy> ≺ ([(x, y)] ∙ P')"
proof(cases "y=x")
case True
with PTrans show ?thesis by simp
next
case False
from PTrans obtain P'' P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼a<νx> ≺ P''"
and P''Chain: "P'' ⟹⇩τ P'"
by(force dest: transitionE)
note PChain
moreover from PChain ‹y ♯ P› have "y ♯ P'''" by(rule freshChain)
with P'''Trans have "y ♯ P''" using ‹y ≠ x› by(rule freshTransition)
with P'''Trans have "P''' ⟼a<νy> ≺ ([(x, y)] ∙ P'')" by(simp add: alphaBoundOutput name_swap)
moreover from P''Chain have "([(x, y)] ∙ P'') ⟹⇩τ ([(x, y)] ∙ P')"
by(rule eqvtChainI)
ultimately show ?thesis by(rule transitionI)
qed
lemma singleActionChain:
fixes P :: pi
and Rs :: residual
shows "P ⟼a<νx> ≺ P' ⟹ P ⟹a<νx> ≺ P'"
and "P ⟼α ≺ P' ⟹ P ⟹α ≺ P'"
proof -
have "P ⟹⇩τ P" by simp
moreover assume "P ⟼a<νx> ≺ P'"
moreover have "P' ⟹⇩τ P'" by simp
ultimately show "P ⟹a<νx> ≺ P'"
by(rule transitionI)
next
have "P ⟹⇩τ P" by simp
moreover assume "P ⟼α ≺ P'"
moreover have "P' ⟹⇩τ P'" by simp
ultimately show "P ⟹α ≺ P'"
by(rule transitionI)
qed
lemma Tau:
fixes P :: pi
shows "τ.(P) ⟹ τ ≺ P"
proof -
have "τ.(P) ⟹⇩τ τ.(P)" by simp
moreover have "τ.(P) ⟼τ ≺ P" by(rule Early_Semantics.Tau)
moreover have "P ⟹⇩τ P" by simp
ultimately show ?thesis by(rule transitionI)
qed
lemma Input:
fixes a :: name
and x :: name
and u :: name
and P :: pi
shows "a<x>.P ⟹ a<u> ≺ P[x::=u]"
proof -
have "a<x>.P ⟹⇩τ a<x>.P" by simp
moreover have "a<x>.P ⟼ a<u> ≺ P[x::=u]" by(rule Early_Semantics.Input)
moreover have "P[x::=u] ⟹⇩τ P[x::=u]" by simp
ultimately show ?thesis by(rule transitionI)
qed
lemma Output:
fixes a :: name
and b :: name
and P :: pi
shows "a{b}.P ⟹a[b] ≺ P"
proof -
have "a{b}.P ⟹⇩τ a{b}.P" by simp
moreover have "a{b}.P ⟼a[b] ≺ P" by(rule Early_Semantics.Output)
moreover have "P ⟹⇩τ P" by simp
ultimately show ?thesis by(rule transitionI)
qed
lemma Match:
fixes P :: pi
and b :: name
and x :: name
and a :: name
and P' :: pi
and α :: freeRes
shows "P ⟹b<νx> ≺ P' ⟹ [a⌢a]P ⟹b<νx> ≺ P'"
and "P ⟹α ≺ P' ⟹ [a⌢a]P ⟹α ≺ P'"
proof -
assume "P ⟹ b<νx> ≺ P'"
then obtain P'' P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼b<νx> ≺ P''"
and P''Chain: "P'' ⟹⇩τ P'"
by(force dest: transitionE)
show "[a⌢a]P ⟹b<νx> ≺ P'"
proof(cases "P = P'''")
case True
have "[a⌢a]P ⟹⇩τ [a⌢a]P" by simp
moreover from ‹P = P'''› P'''Trans have "[a⌢a]P ⟼ b<νx> ≺ P''"
by(rule_tac Early_Semantics.Match) auto
ultimately show ?thesis using P''Chain by(rule transitionI)
next
case False
from PChain ‹P ≠ P'''› have "[a⌢a]P ⟹⇩τ P'''" by(rule matchChain)
thus ?thesis using P'''Trans P''Chain by(rule transitionI)
qed
next
assume "P ⟹α ≺ P'"
then obtain P'' P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼α ≺ P''"
and P''Chain: "P'' ⟹⇩τ P'"
by(force dest: transitionE)
show "[a⌢a]P ⟹α ≺ P'"
proof(cases "P = P'''")
case True
have "[a⌢a]P ⟹⇩τ [a⌢a]P" by simp
moreover from ‹P = P'''› P'''Trans have "[a⌢a]P ⟼α ≺ P''"
by(rule_tac Early_Semantics.Match) auto
ultimately show ?thesis using P''Chain by(rule transitionI)
next
case False
from PChain ‹P ≠ P'''› have "[a⌢a]P ⟹⇩τ P'''" by(rule matchChain)
thus ?thesis using P'''Trans P''Chain by(rule transitionI)
qed
qed
lemma Mismatch:
fixes P :: pi
and c :: name
and x :: name
and a :: name
and b :: name
and P' :: pi
and α :: freeRes
shows "⟦P ⟹c<νx> ≺ P'; a ≠ b⟧ ⟹ [a≠b]P ⟹c<νx> ≺ P'"
and "⟦P ⟹α ≺ P'; a ≠ b⟧ ⟹ [a≠b]P ⟹α ≺ P'"
proof -
assume "P ⟹c<νx> ≺ P'"
then obtain P'' P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼c<νx> ≺ P''"
and P''Chain: "P'' ⟹⇩τ P'"
by(force dest: transitionE)
assume "a ≠ b"
show "[a≠b]P ⟹c<νx> ≺ P'"
proof(cases "P = P'''")
case True
have "[a≠b]P ⟹⇩τ [a≠b]P" by simp
moreover from ‹P = P'''› ‹a ≠ b› P'''Trans have "[a≠b]P ⟼ c<νx> ≺ P''"
by(rule_tac Early_Semantics.Mismatch) auto
ultimately show ?thesis using P''Chain by(rule transitionI)
next
case False
from PChain ‹a ≠ b› ‹P ≠ P'''› have "[a≠b]P ⟹⇩τ P'''" by(rule mismatchChain)
thus ?thesis using P'''Trans P''Chain by(rule transitionI)
qed
next
assume "P ⟹α ≺ P'"
then obtain P'' P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼α ≺ P''"
and P''Chain: "P'' ⟹⇩τ P'"
by(force dest: transitionE)
assume "a ≠ b"
show "[a≠b]P ⟹α ≺ P'"
proof(cases "P = P'''")
case True
have "[a≠b]P ⟹⇩τ [a≠b]P" by simp
moreover from ‹P = P'''› ‹a ≠ b› P'''Trans have "[a≠b]P ⟼α ≺ P''"
by(rule_tac Early_Semantics.Mismatch) auto
ultimately show ?thesis using P''Chain by(rule transitionI)
next
case False
from PChain ‹a ≠ b› ‹P ≠ P'''› have "[a≠b]P ⟹⇩τ P'''" by(rule mismatchChain)
thus ?thesis using P'''Trans P''Chain by(rule transitionI)
qed
qed
lemma Open:
fixes P :: pi
and a :: name
and b :: name
and P' :: pi
assumes PTrans: "P ⟹a[b] ≺ P'"
and "a ≠ b"
shows "<νb>P ⟹a<νb> ≺ P'"
proof -
from PTrans obtain P'' P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼a[b] ≺ P''"
and P''Chain: "P'' ⟹⇩τ P'"
by(force dest: transitionE)
from PChain have "<νb>P ⟹⇩τ <νb>P'''" by(rule ResChain)
moreover from P'''Trans ‹a ≠ b› have "<νb>P''' ⟼a<νb> ≺ P''" by(rule Open)
ultimately show ?thesis using P''Chain by(rule transitionI)
qed
lemma Sum1:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
and Q :: pi
and α :: freeRes
shows "P ⟹a<νx> ≺ P' ⟹ P ⊕ Q ⟹a<νx> ≺ P'"
and "P ⟹α ≺ P' ⟹ P ⊕ Q ⟹α ≺ P'"
proof -
assume "P ⟹a<νx> ≺ P'"
then obtain P'' P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼a<νx> ≺ P''"
and P''Chain: "P'' ⟹⇩τ P'"
by(force dest: transitionE)
show "P ⊕ Q ⟹a<νx> ≺ P'"
proof(cases "P = P'''")
case True
have "P ⊕ Q ⟹⇩τ P ⊕ Q" by simp
moreover from P'''Trans ‹P = P'''› have "P ⊕ Q ⟼ a<νx> ≺ P''" by(blast intro: Sum1)
ultimately show ?thesis using P''Chain by(rule transitionI)
next
case False
from PChain ‹P ≠ P'''› have "P ⊕ Q ⟹⇩τ P'''" by(rule sum1Chain)
thus ?thesis using P'''Trans P''Chain by(rule transitionI)
qed
next
assume "P ⟹α ≺ P'"
then obtain P'' P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼α ≺ P''"
and P''Chain: "P'' ⟹⇩τ P'"
by(force dest: transitionE)
show "P ⊕ Q ⟹α ≺ P'"
proof(cases "P = P'''")
case True
have "P ⊕ Q ⟹⇩τ P ⊕ Q" by simp
moreover from P'''Trans ‹P = P'''› have "P ⊕ Q ⟼α ≺ P''" by(blast intro: Sum1)
ultimately show ?thesis using P''Chain by(rule transitionI)
next
case False
from PChain ‹P ≠ P'''› have "P ⊕ Q ⟹⇩τ P'''" by(rule sum1Chain)
thus ?thesis using P'''Trans P''Chain by(rule transitionI)
qed
qed
lemma Sum2:
fixes Q :: pi
and a :: name
and x :: name
and Q' :: pi
and P :: pi
and α :: freeRes
shows "Q ⟹a<νx> ≺ Q' ⟹ P ⊕ Q ⟹a<νx> ≺ Q'"
and "Q ⟹α ≺ Q' ⟹ P ⊕ Q ⟹α ≺ Q'"
proof -
assume "Q ⟹a<νx> ≺ Q'"
then obtain Q'' Q''' where QChain: "Q ⟹⇩τ Q'''"
and Q'''Trans: "Q''' ⟼a<νx> ≺ Q''"
and Q''Chain: "Q'' ⟹⇩τ Q'"
by(force dest: transitionE)
show "P ⊕ Q ⟹a<νx> ≺ Q'"
proof(cases "Q = Q'''")
case True
have "P ⊕ Q ⟹⇩τ P ⊕ Q" by simp
moreover from Q'''Trans ‹Q = Q'''› have "P ⊕ Q ⟼a<νx> ≺ Q''" by(blast intro: Sum2)
ultimately show ?thesis using Q''Chain by(rule transitionI)
next
case False
from QChain ‹Q ≠ Q'''› have "P ⊕ Q ⟹⇩τ Q'''" by(rule sum2Chain)
thus ?thesis using Q'''Trans Q''Chain by(rule transitionI)
qed
next
assume "Q ⟹α ≺ Q'"
then obtain Q'' Q''' where QChain: "Q ⟹⇩τ Q'''"
and Q'''Trans: "Q''' ⟼α ≺ Q''"
and Q''Chain: "Q'' ⟹⇩τ Q'"
by(force dest: transitionE)
show "P ⊕ Q ⟹α ≺ Q'"
proof(cases "Q = Q'''")
case True
have "P ⊕ Q ⟹⇩τ P ⊕ Q" by simp
moreover from Q'''Trans ‹Q = Q'''› have "P ⊕ Q ⟼α ≺ Q''" by(blast intro: Sum2)
ultimately show ?thesis using Q''Chain by(rule transitionI)
next
case False
from QChain ‹Q ≠ Q'''› have "P ⊕ Q ⟹⇩τ Q'''" by(rule sum2Chain)
thus ?thesis using Q'''Trans Q''Chain by(rule transitionI)
qed
qed
lemma Par1B:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
and Q :: pi
assumes PTrans: "P ⟹a<νx> ≺ P'"
and "x ♯ Q"
shows "P ∥ Q ⟹a<νx> ≺ (P' ∥ Q)"
proof -
from PTrans obtain P'' P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼a<νx> ≺ P''"
and P''Chain: "P'' ⟹⇩τ P'"
by(blast dest: transitionE)
from PChain have "P ∥ Q ⟹⇩τ P''' ∥ Q" by(rule Par1Chain)
moreover from P'''Trans ‹x ♯ Q› have "P''' ∥ Q ⟼a<νx> ≺ (P'' ∥ Q)" by(rule Early_Semantics.Par1B)
moreover from P''Chain have "P'' ∥ Q ⟹⇩τ P' ∥ Q" by(rule Par1Chain)
ultimately show "P ∥ Q ⟹a<νx> ≺ (P' ∥ Q)" by(rule transitionI)
qed
lemma Par1F:
fixes P :: pi
and α :: freeRes
and P' :: pi
and Q :: pi
assumes PTrans: "P ⟹α ≺ P'"
shows "P ∥ Q ⟹α ≺ (P' ∥ Q)"
proof -
from PTrans obtain P'' P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼α ≺ P''"
and P''Chain: "P'' ⟹⇩τ P'"
by(blast dest: transitionE)
from PChain have "P ∥ Q ⟹⇩τ P''' ∥ Q" by(rule Par1Chain)
moreover from P'''Trans have "P''' ∥ Q ⟼α ≺ (P'' ∥ Q)" by(rule Early_Semantics.Par1F)
moreover from P''Chain have "P'' ∥ Q ⟹⇩τ P' ∥ Q" by(rule Par1Chain)
ultimately show ?thesis by(rule transitionI)
qed
lemma Par2B:
fixes Q :: pi
and a :: name
and x :: name
and Q' :: pi
and P :: pi
assumes QTrans: "Q ⟹a<νx> ≺ Q'"
and "x ♯ P"
shows "P ∥ Q ⟹a<νx> ≺ (P ∥ Q')"
proof -
from QTrans obtain Q'' Q''' where QChain: "Q ⟹⇩τ Q'''"
and Q'''Trans: "Q''' ⟼a<νx> ≺ Q''"
and Q''Chain: "Q'' ⟹⇩τ Q'"
by(blast dest: transitionE)
from QChain have "P ∥ Q ⟹⇩τ P ∥ Q'''" by(rule Par2Chain)
moreover from Q'''Trans ‹x ♯ P› have "P ∥ Q''' ⟼a<νx> ≺ (P ∥ Q'')" by(rule Early_Semantics.Par2B)
moreover from Q''Chain have "P ∥ Q'' ⟹⇩τ P ∥ Q'" by(rule Par2Chain)
ultimately show "P ∥ Q ⟹a<νx> ≺ (P ∥ Q')" by(rule transitionI)
qed
lemma Par2F:
fixes Q :: pi
and α :: freeRes
and Q' :: pi
and P :: pi
assumes QTrans: "Q ⟹α ≺ Q'"
shows "P ∥ Q ⟹α ≺ (P ∥ Q')"
proof -
from QTrans obtain Q'' Q''' where QChain: "Q ⟹⇩τ Q'''"
and Q'''Trans: "Q''' ⟼α ≺ Q''"
and Q''Chain: "Q'' ⟹⇩τ Q'"
by(blast dest: transitionE)
from QChain have "P ∥ Q ⟹⇩τ P ∥ Q'''" by(rule Par2Chain)
moreover from Q'''Trans have "P ∥ Q''' ⟼α ≺ (P ∥ Q'')" by(rule Early_Semantics.Par2F)
moreover from Q''Chain have "P ∥ Q'' ⟹⇩τ P ∥ Q'" by(rule Par2Chain)
ultimately show ?thesis by(rule transitionI)
qed
lemma Comm1:
fixes P :: pi
and a :: name
and b :: name
and P' :: pi
and Q :: pi
and Q' :: pi
assumes PTrans: "P ⟹a<b> ≺ P'"
and QTrans: "Q ⟹a[b] ≺ Q'"
shows "P ∥ Q ⟹τ ≺ P' ∥ Q'"
proof -
from PTrans obtain P'' P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼a<b> ≺ P''"
and P''Chain: "P'' ⟹⇩τ P'"
by(blast dest: transitionE)
from QTrans obtain Q'' Q''' where QChain: "Q ⟹⇩τ Q'''"
and Q'''Trans: "Q''' ⟼a[b] ≺ Q''"
and Q''Chain: "Q'' ⟹⇩τ Q'"
by(blast dest: transitionE)
from PChain QChain have "P ∥ Q ⟹⇩τ P''' ∥ Q'''" by(rule chainPar)
moreover from P'''Trans Q'''Trans have "P''' ∥ Q''' ⟼τ ≺ P'' ∥ Q''"
by(rule Early_Semantics.Comm1)
moreover from P''Chain Q''Chain have "P'' ∥ Q'' ⟹⇩τ P' ∥ Q'" by(rule chainPar)
ultimately show ?thesis by(rule transitionI)
qed
lemma Comm2:
fixes P :: pi
and a :: name
and b :: name
and P' :: pi
and Q :: pi
and Q' :: pi
assumes PTrans: "P ⟹a[b] ≺ P'"
and QTrans: "Q ⟹a<b> ≺ Q'"
shows "P ∥ Q ⟹τ ≺ P' ∥ Q'"
proof -
from PTrans obtain P'' P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼a[b] ≺ P''"
and P''Chain: "P'' ⟹⇩τ P'"
by(blast dest: transitionE)
from QTrans obtain Q'' Q''' where QChain: "Q ⟹⇩τ Q'''"
and Q'''Trans: "Q''' ⟼a<b> ≺ Q''"
and Q''Chain: "Q'' ⟹⇩τ Q'"
by(blast dest: transitionE)
from PChain QChain have "P ∥ Q ⟹⇩τ P''' ∥ Q'''" by(rule chainPar)
moreover from P'''Trans Q'''Trans have "P''' ∥ Q''' ⟼τ ≺ P'' ∥ Q''"
by(rule Early_Semantics.Comm2)
moreover from P''Chain Q''Chain have "P'' ∥ Q'' ⟹⇩τ P' ∥ Q'" by(rule chainPar)
ultimately show ?thesis by(rule transitionI)
qed
lemma Close1:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
and Q :: pi
and Q' :: pi
assumes PTrans: "P ⟹a<x> ≺ P'"
and QTrans: "Q ⟹a<νx> ≺ Q'"
and "x ♯ P"
shows "P ∥ Q ⟹τ ≺ <νx>(P' ∥ Q')"
proof -
from PTrans obtain P''' P'' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼a<x> ≺ P''"
and P''Chain: "P'' ⟹⇩τ P'"
by(blast dest: transitionE)
from QTrans obtain Q'' Q''' where QChain: "Q ⟹⇩τ Q'''"
and Q'''Trans: "Q''' ⟼a<νx> ≺ Q''"
and Q''Chain: "Q'' ⟹⇩τ Q'"
by(blast dest: transitionE)
from PChain QChain have "P ∥ Q ⟹⇩τ P''' ∥ Q'''" by(rule chainPar)
moreover from PChain ‹x ♯ P› have "x ♯ P'''" by(rule freshChain)
with P'''Trans Q'''Trans have "P''' ∥ Q''' ⟼τ ≺ <νx>(P'' ∥ Q'')"
by(rule Early_Semantics.Close1)
moreover from P''Chain Q''Chain have "P'' ∥ Q'' ⟹⇩τ P' ∥ Q'" by(rule chainPar)
hence "<νx>(P'' ∥ Q'') ⟹⇩τ <νx>(P' ∥ Q')" by(rule ResChain)
ultimately show ?thesis by(rule transitionI)
qed
lemma Close2:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
and Q :: pi
and Q' :: pi
assumes PTrans: "P ⟹a<νx> ≺ P'"
and QTrans: "Q ⟹a<x> ≺ Q'"
and xFreshQ: "x ♯ Q"
shows "P ∥ Q ⟹τ ≺ <νx>(P' ∥ Q')"
proof -
from PTrans obtain P'' P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼a<νx> ≺ P''"
and P''Chain: "P'' ⟹⇩τ P'"
by(blast dest: transitionE)
from QTrans obtain Q'' Q''' where QChain: "Q ⟹⇩τ Q'''"
and Q'''Trans: "Q''' ⟼a<x> ≺ Q''"
and Q''Chain: "Q'' ⟹⇩τ Q'"
by(blast dest: transitionE)
from PChain QChain have "P ∥ Q ⟹⇩τ P''' ∥ Q'''" by(rule chainPar)
moreover from QChain ‹x ♯ Q› have "x ♯ Q'''" by(rule freshChain)
with P'''Trans Q'''Trans have "P''' ∥ Q''' ⟼τ ≺ <νx>(P'' ∥ Q'')"
by(rule Early_Semantics.Close2)
moreover from P''Chain Q''Chain have "P'' ∥ Q'' ⟹⇩τ P' ∥ Q'" by(rule chainPar)
hence "<νx>(P'' ∥ Q'') ⟹⇩τ <νx>(P' ∥ Q')" by(rule ResChain)
ultimately show ?thesis by(rule transitionI)
qed
lemma ResF:
fixes P :: pi
and α :: freeRes
and P' :: pi
and x :: name
assumes PTrans: "P ⟹α ≺ P'"
and "x ♯ α"
shows "<νx>P ⟹α ≺ <νx>P'"
proof -
from PTrans obtain P'' P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼α ≺ P''"
and P''Chain: "P'' ⟹⇩τ P'"
by(blast dest: transitionE)
from PChain have "<νx>P ⟹⇩τ <νx>P'''" by(rule ResChain)
moreover from P'''Trans ‹x ♯ α› have "<νx>P''' ⟼α ≺ <νx>P''"
by(rule Early_Semantics.ResF)
moreover from P''Chain have "<νx>P'' ⟹⇩τ <νx>P'" by(rule ResChain)
ultimately show ?thesis by(rule transitionI)
qed
lemma ResB:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
and y :: name
assumes PTrans: "P ⟹a<νx> ≺ P'"
and "y ≠ a"
and "y ≠ x"
shows "<νy>P ⟹a<νx> ≺ (<νy>P')"
proof -
from PTrans obtain P'' P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼a<νx> ≺ P''"
and P''Chain: "P'' ⟹⇩τ P'"
by(blast dest: transitionE)
from PChain have "<νy>P ⟹⇩τ <νy>P'''" by(rule ResChain)
moreover from P'''Trans ‹y ≠ a› ‹y ≠ x› have "<νy>P''' ⟼a<νx> ≺ (<νy>P'')"
by(rule Early_Semantics.ResB)
moreover from P''Chain have "<νy>P'' ⟹⇩τ <νy>P'" by(rule ResChain)
ultimately show ?thesis by(rule transitionI)
qed
lemma Bang:
fixes P :: pi
and Rs :: residual
shows "P ∥ !P ⟹a<νx> ≺ P' ⟹ !P ⟹a<νx> ≺ P'"
and "P ∥ !P ⟹α ≺ P' ⟹ !P ⟹α ≺ P'"
proof -
assume PTrans: "P ∥ !P ⟹ a<νx> ≺ P'"
from PTrans obtain P'' P''' where PChain: "P ∥ !P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼a<νx> ≺ P''"
and P''Chain: "P'' ⟹⇩τ P'"
by(force dest: transitionE)
show "!P ⟹a<νx> ≺ P'"
proof(cases "P''' = P ∥ !P")
case True
have "!P ⟹⇩τ !P" by simp
moreover from P'''Trans ‹P''' = P ∥ !P› have "!P ⟼a<νx> ≺ P''" by(blast intro: Early_Semantics.Bang)
ultimately show ?thesis using P''Chain by(rule transitionI)
next
case False
from PChain ‹P''' ≠ P ∥ !P› have "!P ⟹⇩τ P'''" by(rule bangChain)
with P'''Trans P''Chain show ?thesis by(blast intro: transitionI)
qed
next
fix α P' P
assume "P ∥ !P ⟹α ≺ P'"
then obtain P'' P''' where PChain: "P ∥ !P ⟹⇩τ P''"
and P''Trans: "P'' ⟼α ≺ P'''"
and P'''Chain: "P''' ⟹⇩τ P'"
by(force dest: transitionE)
show "!P ⟹α ≺ P'"
proof(cases "P'' = P ∥ !P")
assume "P'' = P ∥ !P"
moreover with P''Trans have "!P ⟼α ≺ P'''" by(blast intro: Bang)
ultimately show ?thesis using PChain P'''Chain by(rule_tac transitionI, auto)
next
assume "P'' ≠ P ∥ !P"
with PChain have "!P ⟹⇩τ P''" by(rule bangChain)
with P''Trans P'''Chain show ?thesis by(blast intro: transitionI)
qed
qed
lemma tauTransitionChain:
fixes P :: pi
and P' :: pi
assumes "P ⟹τ ≺ P'"
shows "P ⟹⇩τ P'"
using assms
by(force dest: transitionE tauActTauChain)
lemma chainTransitionAppend:
fixes P :: pi
and P' :: pi
and Rs :: residual
and a :: name
and x :: name
and P'' :: pi
and α :: freeRes
shows "P ⟹a<νx> ≺ P'' ⟹ P'' ⟹⇩τ P' ⟹ P ⟹a<νx> ≺ P'"
and "P ⟹α ≺ P'' ⟹ P'' ⟹⇩τ P' ⟹ P ⟹α ≺ P'"
and "P ⟹⇩τ P'' ⟹ P'' ⟹a<νx> ≺ P' ⟹ P ⟹a<νx> ≺ P'"
and "P ⟹⇩τ P'' ⟹ P'' ⟹α ≺ P' ⟹ P ⟹α ≺ P'"
proof -
assume PTrans: "P ⟹ a<νx> ≺ P''"
assume P''Chain: "P'' ⟹⇩τ P'"
from PTrans obtain P''' P'''' where PChain: "P ⟹⇩τ P''''"
and P''''Trans: "P'''' ⟼a<νx> ≺ P'''"
and P'''Chain: "P''' ⟹⇩τ P''"
by(blast dest: transitionE)
from P'''Chain P''Chain have "P''' ⟹⇩τ P'" by auto
with PChain P''''Trans show "P ⟹a<νx> ≺ P'" by(rule transitionI)
next
assume PTrans: "P ⟹α ≺ P''"
assume P''Chain: "P'' ⟹⇩τ P'"
from PTrans obtain P''' P'''' where PChain: "P ⟹⇩τ P''''"
and P''''Trans: "P'''' ⟼α ≺ P'''"
and P'''Chain: "P''' ⟹⇩τ P''"
by(blast dest: transitionE)
from P'''Chain P''Chain have "P''' ⟹⇩τ P'" by auto
with PChain P''''Trans show "P ⟹α ≺ P'" by(rule transitionI)
next
assume PChain: "P ⟹⇩τ P''"
assume P''Trans: "P'' ⟹ a<νx> ≺ P'"
from P''Trans obtain P''' P'''' where P''Chain: "P'' ⟹⇩τ P''''"
and P''''Trans: "P'''' ⟼a<νx> ≺ P'''"
and P'''Chain: "P''' ⟹⇩τ P'"
by(blast dest: transitionE)
from PChain P''Chain have "P ⟹⇩τ P''''" by auto
thus "P ⟹a<νx> ≺ P'" using P''''Trans P'''Chain by(rule transitionI)
next
assume PChain: "P ⟹⇩τ P''"
assume P''Trans: "P'' ⟹α ≺ P'"
from P''Trans obtain P''' P'''' where P''Chain: "P'' ⟹⇩τ P''''"
and P''''Trans: "P'''' ⟼α ≺ P'''"
and P'''Chain: "P''' ⟹⇩τ P'"
by(blast dest: transitionE)
from PChain P''Chain have "P ⟹⇩τ P''''" by auto
thus "P ⟹α ≺ P'" using P''''Trans P'''Chain by(rule transitionI)
qed
lemma freshBoundOutputTransition:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
and c :: name
assumes PTrans: "P ⟹a<νx> ≺ P'"
and "c ♯ P"
and "c ≠ x"
shows "c ♯ P'"
proof -
from PTrans obtain P'' P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼a<νx> ≺ P''"
and P''Chain: "P'' ⟹⇩τ P'"
by(blast dest: transitionE)
from PChain ‹c ♯ P› have "c ♯ P'''" by(rule freshChain)
with P'''Trans have "c ♯ P''" using ‹c ≠ x› by(rule Early_Semantics.freshTransition)
with P''Chain show "c ♯ P'" by(rule freshChain)
qed
lemma freshTauTransition:
fixes P :: pi
and c :: name
assumes PTrans: "P ⟹τ ≺ P'"
and "c ♯ P"
shows "c ♯ P'"
proof -
from PTrans have "P ⟹⇩τ P'" by(rule tauTransitionChain)
thus ?thesis using ‹c ♯ P› by(rule freshChain)
qed
lemma freshOutputTransition:
fixes P :: pi
and a :: name
and b :: name
and P' :: pi
and c :: name
assumes PTrans: "P ⟹a[b] ≺ P'"
and "c ♯ P"
shows "c ♯ P'"
proof -
from PTrans obtain P'' P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼a[b] ≺ P''"
and P''Chain: "P'' ⟹⇩τ P'"
by(blast dest: transitionE)
from PChain ‹c ♯ P› have "c ♯ P'''" by(rule freshChain)
with P'''Trans have "c ♯ P''" by(rule Early_Semantics.freshTransition)
with P''Chain show ?thesis by(rule freshChain)
qed
lemma eqvtI[eqvt]:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
and p :: "name prm"
and α :: freeRes
shows "P ⟹a<νx> ≺ P' ⟹ (p ∙ P) ⟹(p ∙ a)<ν(p ∙ x)> ≺ (p ∙ P')"
and "P ⟹α ≺ P' ⟹ (p ∙ P) ⟹(p ∙ α) ≺ (p ∙ P')"
proof -
assume "P ⟹a<νx> ≺ P'"
then obtain P'' P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼a<νx> ≺ P''"
and P''Chain: "P'' ⟹⇩τ P'"
by(blast dest: transitionE)
from PChain have "(p ∙ P) ⟹⇩τ (p ∙ P''')" by(rule eqvtChainI)
moreover from P'''Trans have "(p ∙ P''') ⟼ (p ∙ (a<νx> ≺ P''))"
by(rule TransitionsEarly.eqvt)
hence "(p ∙ P''') ⟼ (p ∙ a)<ν(p ∙ x)> ≺ (p ∙ P'')"
by(simp add: eqvts)
moreover from P''Chain have "(p ∙ P'') ⟹⇩τ (p ∙ P')" by(rule eqvtChainI)
ultimately show "(p ∙ P) ⟹(p ∙ a)<ν(p ∙ x)> ≺ (p ∙ P')"
by(rule transitionI)
next
assume "P ⟹α ≺ P'"
then obtain P'' P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼α ≺ P''"
and P''Chain: "P'' ⟹⇩τ P'"
by(blast dest: transitionE)
from PChain have "(p ∙ P) ⟹⇩τ (p ∙ P''')" by(rule eqvtChainI)
moreover from P'''Trans have "(p ∙ P''') ⟼ (p ∙ (α ≺ P''))"
by(rule TransitionsEarly.eqvt)
hence "(p ∙ P''') ⟼ (p ∙ α) ≺ (p ∙ P'')"
by(simp add: eqvts)
moreover from P''Chain have "(p ∙ P'') ⟹⇩τ (p ∙ P')" by(rule eqvtChainI)
ultimately show "(p ∙ P) ⟹(p ∙ α) ≺ (p ∙ P')"
by(rule transitionI)
qed
lemma freshInputTransition:
fixes P :: pi
and a :: name
and b :: name
and P' :: pi
and c :: name
assumes PTrans: "P ⟹a<b> ≺ P'"
and "c ♯ P"
and "c ≠ b"
shows "c ♯ P'"
proof -
from PTrans obtain P'' P''' where PChain: "P ⟹⇩τ P'''"
and P'''Trans: "P''' ⟼a<b> ≺ P''"
and P''Chain: "P'' ⟹⇩τ P'"
by(blast dest: transitionE)
from PChain ‹c ♯ P› have "c ♯ P'''" by(rule freshChain)
with P'''Trans have "c ♯ P''" using ‹c ≠ b› by(rule Early_Semantics.freshInputTransition)
with P''Chain show ?thesis by(rule freshChain)
qed
lemmas freshTransition = freshBoundOutputTransition freshOutputTransition
freshInputTransition freshTauTransition
end
Theory Weak_Early_Semantics
theory Weak_Early_Semantics
imports Weak_Early_Step_Semantics
begin
definition weakFreeTransition :: "pi ⇒ freeRes ⇒ pi ⇒ bool" ("_ ⟹⇧^_ ≺ _" [80, 80, 80] 80)
where "P ⟹⇧^α ≺ P' ≡ P ⟹α ≺ P' ∨ (α = τ ∧ P = P')"
lemma weakTransitionI:
fixes P :: pi
and α :: freeRes
and P' :: pi
shows "P ⟹α ≺ P' ⟹ P ⟹⇧^α ≺ P'"
and "P ⟹⇧^τ ≺ P"
by(auto simp add: weakFreeTransition_def)
lemma transitionCases[consumes 1, case_names Step Stay]:
fixes P :: pi
and α :: freeRes
and P' :: pi
assumes "P ⟹⇧^α ≺ P'"
and "P ⟹α ≺ P' ⟹ F α P'"
and "F (τ) P"
shows "F α P'"
using assms
by(auto simp add: weakFreeTransition_def)
lemma singleActionChain:
fixes P :: pi
and α :: freeRes
and P' :: pi
assumes "P ⟼α ≺ P'"
shows "P ⟹⇧^α ≺ P'"
using assms
by(auto dest: singleActionChain intro: weakTransitionI)
lemma Tau:
fixes P :: pi
shows "τ.(P) ⟹⇧^ τ ≺ P"
by(auto intro: Weak_Early_Step_Semantics.Tau
simp add: weakFreeTransition_def)
lemma Input:
fixes a :: name
and x :: name
and u :: name
and P :: pi
shows "a<x>.P ⟹⇧^ a<u> ≺ P[x::=u]"
by(auto intro: Weak_Early_Step_Semantics.Input
simp add: weakFreeTransition_def)
lemma Output:
fixes a :: name
and b :: name
and P :: pi
shows "a{b}.P ⟹⇧^a[b] ≺ P"
by(auto intro: Weak_Early_Step_Semantics.Output
simp add: weakFreeTransition_def)
lemma Par1F:
fixes P :: pi
and α :: freeRes
and P' :: pi
and Q :: pi
assumes "P ⟹⇧^α ≺ P'"
shows "P ∥ Q ⟹⇧^α ≺ (P' ∥ Q)"
using assms
by(auto intro: Weak_Early_Step_Semantics.Par1F
simp add: weakFreeTransition_def residual.inject)
lemma Par2F:
fixes Q :: pi
and α :: freeRes
and Q' :: pi
and P :: pi
assumes QTrans: "Q ⟹⇧^α ≺ Q'"
shows "P ∥ Q ⟹⇧^α ≺ (P ∥ Q')"
using assms
by(auto intro: Weak_Early_Step_Semantics.Par2F
simp add: weakFreeTransition_def residual.inject)
lemma ResF:
fixes P :: pi
and α :: freeRes
and P' :: pi
and x :: name
assumes "P ⟹⇧^α ≺ P'"
and "x ♯ α"
shows "<νx>P ⟹⇧^α ≺ <νx>P'"
using assms
by(auto intro: Weak_Early_Step_Semantics.ResF
simp add: weakFreeTransition_def residual.inject)
lemma Bang:
fixes P :: pi
and Rs :: residual
assumes "P ∥ !P ⟹⇧^α ≺ P'"
and "P' ≠ P ∥ !P"
shows "!P ⟹⇧^α ≺ P'"
using assms
by(auto intro: Weak_Early_Step_Semantics.Bang
simp add: weakFreeTransition_def residual.inject)
lemma tauTransitionChain[simp]:
fixes P :: pi
and P' :: pi
shows "P ⟹⇧^τ ≺ P' = P ⟹⇩τ P'"
apply(auto dest: Weak_Early_Step_Semantics.tauTransitionChain
simp add: weakFreeTransition_def)
by(erule rtrancl.cases) (auto intro: transitionI)
lemma tauStepTransitionChain[simp]:
fixes P :: pi
and P' :: pi
assumes "P ≠ P'"
shows "P ⟹τ ≺ P' = P ⟹⇩τ P'"
using assms
apply(auto dest: Weak_Early_Step_Semantics.tauTransitionChain
simp add: weakFreeTransition_def)
by(erule rtrancl.cases) (auto intro: transitionI)
lemma chainTransitionAppend:
fixes P :: pi
and P' :: pi
and Rs :: residual
and a :: name
and x :: name
and P'' :: pi
and α :: freeRes
shows "P ⟹⇩τ P'' ⟹ P'' ⟹⇧^α ≺ P' ⟹ P ⟹⇧^α ≺ P'"
and "P ⟹⇧^α ≺ P'' ⟹ P'' ⟹⇩τ P' ⟹ P ⟹⇧^α ≺ P'"
by(auto intro: chainTransitionAppend simp add: weakFreeTransition_def dest: Weak_Early_Step_Semantics.tauTransitionChain)
lemma freshTauTransition:
fixes P :: pi
and c :: name
assumes "P ⟹⇧^τ ≺ P'"
and "c ♯ P"
shows "c ♯ P'"
using assms
by(auto intro: Weak_Early_Step_Semantics.freshTauTransition
simp add: weakFreeTransition_def residual.inject)
lemma freshOutputTransition:
fixes P :: pi
and a :: name
and b :: name
and P' :: pi
and c :: name
assumes "P ⟹⇧^a[b] ≺ P'"
and "c ♯ P"
shows "c ♯ P'"
using assms
by(auto intro: Weak_Early_Step_Semantics.freshOutputTransition
simp add: weakFreeTransition_def residual.inject)
lemma eqvtI:
fixes P :: pi
and α :: freeRes
and P' :: pi
and p :: "name prm"
assumes "P ⟹⇧^α ≺ P'"
shows "(p ∙ P) ⟹⇧^(p ∙ α) ≺ (p ∙ P')"
using assms
by(auto intro: Weak_Early_Step_Semantics.eqvtI
simp add: weakFreeTransition_def residual.inject)
lemma freshInputTransition:
fixes P :: pi
and a :: name
and b :: name
and P' :: pi
and c :: name
assumes "P ⟹⇧^a<b> ≺ P'"
and "c ♯ P"
and "c ≠ b"
shows "c ♯ P'"
using assms
by(auto intro: Weak_Early_Step_Semantics.freshInputTransition
simp add: weakFreeTransition_def residual.inject)
lemmas freshTransition = freshBoundOutputTransition freshOutputTransition
freshInputTransition freshTauTransition
end
Theory Weak_Early_Sim
theory Weak_Early_Sim
imports Weak_Early_Semantics Strong_Early_Sim_Pres
begin
definition weakSimulation :: "pi ⇒ (pi × pi) set ⇒ pi ⇒ bool" ("_ ↝<_> _" [80, 80, 80] 80)
where "P ↝<Rel> Q ≡ (∀a x Q'. Q ⟼a<νx> ≺ Q' ∧ x ♯ P ⟶ (∃P'. P ⟹a<νx> ≺ P' ∧ (P', Q') ∈ Rel)) ∧
(∀α Q'. Q ⟼α ≺ Q' ⟶ (∃P'. P ⟹⇧^α ≺ P' ∧ (P', Q') ∈ Rel))"
lemma monotonic:
fixes A :: "(pi × pi) set"
and B :: "(pi × pi) set"
and P :: pi
and P' :: pi
assumes "P ↝<A> P'"
and "A ⊆ B"
shows "P ↝<B> P'"
using assms
by(simp add: weakSimulation_def) blast
lemma simCasesCont[consumes 1, case_names Bound Free]:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and C :: "'a::fs_name"
assumes Eqvt: "eqvt Rel"
and Bound: "⋀a x Q'. ⟦Q ⟼ a<νx> ≺ Q'; x ♯ P; x ♯ Q; x ≠ a; x ♯ C⟧ ⟹ ∃P'. P ⟹a<νx> ≺ P' ∧ (P', Q') ∈ Rel"
and Free: "⋀α Q'. Q ⟼ α ≺ Q' ⟹ ∃P'. P ⟹⇧^ α ≺ P' ∧ (P', Q') ∈ Rel"
shows "P ↝<Rel> Q"
proof(auto simp add: weakSimulation_def)
fix a x Q'
assume QTrans: "Q ⟼ a<νx> ≺ Q'" and "x ♯ P"
obtain c::name where "c ♯ P" and "c ♯ Q" and "c ≠ a" and "c ♯ Q'" and "c ♯ C" and "c ≠ x"
by(generate_fresh "name") auto
from QTrans ‹c ♯ Q'› have "Q ⟼ a<νc> ≺ ([(x, c)] ∙ Q')" by(simp add: alphaBoundOutput)
then obtain P' where PTrans: "P ⟹a<νc> ≺ P'" and P'RelQ': "(P', [(x, c)] ∙ Q') ∈ Rel"
using ‹c ♯ P› ‹c ♯ Q› ‹c ≠ a› ‹c ♯ C›
by(drule_tac Bound) auto
from PTrans ‹x ♯ P› ‹c ≠ x› have "P ⟹a<νx> ≺ ([(x, c)] ∙ P')"
by(force intro: weakTransitionAlpha simp add: name_swap)
moreover from Eqvt P'RelQ' have "([(x, c)] ∙ P', [(x, c)] ∙ [(x, c)] ∙ Q') ∈ Rel"
by(rule eqvtRelI)
hence "([(x, c)] ∙ P', Q') ∈ Rel" by simp
ultimately show "∃P'. P ⟹a<νx> ≺ P' ∧ (P', Q') ∈ Rel"
by blast
next
fix α Q'
assume "Q ⟼α ≺ Q'"
thus "∃P'. P ⟹⇧^α ≺ P' ∧ (P', Q') ∈ Rel"
by(rule Free)
qed
lemma simCases[case_names Bound Free]:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and C :: "'a::fs_name"
assumes "⋀Q' a x. ⟦Q ⟼ a<νx> ≺ Q'; x ♯ P⟧ ⟹ ∃P'. P ⟹a<νx> ≺ P' ∧ (P', Q') ∈ Rel"
and "⋀Q' α. Q ⟼ α ≺ Q' ⟹ ∃P'. P ⟹⇧^ α ≺ P' ∧ (P', Q') ∈ Rel"
shows "P ↝<Rel> Q"
using assms
by(auto simp add: weakSimulation_def)
lemma simE:
fixes P :: pi
and Rel :: "(pi × pi) set"
and Q :: pi
and a :: name
and x :: name
and Q' :: pi
assumes "P ↝<Rel> Q"
shows "Q ⟼a<νx> ≺ Q' ⟹ x ♯ P ⟹ ∃P'. P ⟹a<νx> ≺ P' ∧ (P', Q') ∈ Rel"
and "Q ⟼α ≺ Q' ⟹ ∃P'. P ⟹⇧^α ≺ P' ∧ (P', Q') ∈ Rel"
using assms by(simp add: weakSimulation_def)+
lemma weakSimTauChain:
fixes P :: pi
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
and Q :: pi
and Q' :: pi
assumes QChain: "Q ⟹⇩τ Q'"
and PRelQ: "(P, Q) ∈ Rel"
and PSimQ: "⋀R S. (R, S) ∈ Rel ⟹ R ↝<Rel> S"
shows "∃P'. P ⟹⇩τ P' ∧ (P', Q') ∈ Rel"
proof -
from QChain show ?thesis
proof(induct rule: tauChainInduct)
case id
moreover have "P ⟹⇩τ P" by simp
ultimately show ?case using PSimQ PRelQ by blast
next
case(ih Q' Q'')
have "∃P'. P ⟹⇩τ P' ∧ (P', Q') ∈ Rel" by fact
then obtain P' where PChain: "P ⟹⇩τ P'" and P'Rel'Q': "(P', Q') ∈ Rel" by blast
from P'Rel'Q' have "P' ↝<Rel> Q'" by(rule PSimQ)
moreover have Q'Trans: "Q' ⟼τ ≺ Q''" by fact
ultimately obtain P'' where P'Trans: "P' ⟹⇧^τ ≺ P''" and P''RelQ'': "(P'', Q'') ∈ Rel"
by(blast dest: simE)
from P'Trans have "P' ⟹⇩τ P''" by simp
with PChain have "P ⟹⇩τ P''" by auto
with P''RelQ'' show ?case by blast
qed
qed
lemma simE2:
fixes P :: pi
and Rel :: "(pi × pi) set"
and Q :: pi
and a :: name
and x :: name
and Q' :: pi
assumes Sim: "⋀R S. (R, S) ∈ Rel ⟹ R ↝<Rel> S"
and Eqvt: "eqvt Rel"
and PRelQ: "(P, Q) ∈ Rel"
shows "Q ⟹a<νx> ≺ Q' ⟹ x ♯ P ⟹ ∃P'. P ⟹a<νx> ≺ P' ∧ (P', Q') ∈ Rel"
and "Q ⟹⇧^α ≺ Q' ⟹ ∃P'. P ⟹⇧^α ≺ P' ∧ (P', Q') ∈ Rel"
proof -
assume QTrans: "Q ⟹a<νx> ≺ Q'" and "x ♯ P"
from QTrans obtain Q'' Q''' where QChain: "Q ⟹⇩τ Q'''"
and Q'''Trans: "Q''' ⟼a<νx> ≺ Q''"
and Q''Chain: "Q'' ⟹⇩τ Q'"
by(blast dest: transitionE)
from QChain PRelQ Sim obtain P''' where PChain: "P ⟹⇩τ P'''" and P'''RelQ''': "(P''', Q''') ∈ Rel"
by(blast dest: weakSimTauChain)
from PChain ‹x ♯ P› have "x ♯ P'''" by(rule freshChain)
from P'''RelQ''' have "P''' ↝<Rel> Q'''" by(rule Sim)
with Q'''Trans ‹x ♯ P'''› obtain P'' where P'''Trans: "P''' ⟹a<νx> ≺ P''"
and P''RelQ'': "(P'', Q'') ∈ Rel"
by(blast dest: simE)
from Q''Chain P''RelQ'' Sim obtain P' where P''Chain: "P'' ⟹⇩τ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: weakSimTauChain)
from PChain P'''Trans P''Chain have "P ⟹a<νx> ≺ P'"
by(blast dest: Weak_Early_Step_Semantics.chainTransitionAppend)
with P'RelQ' show "∃P'. P ⟹a<νx> ≺ P' ∧ (P', Q') ∈ Rel" by blast
next
assume "Q ⟹⇧^α ≺ Q'"
thus "∃P'. P ⟹⇧^α ≺ P' ∧ (P', Q') ∈ Rel"
proof(induct rule: transitionCases)
case Step
have "Q ⟹α ≺ Q'" by fact
then obtain Q'' Q''' where QChain: "Q ⟹⇩τ Q''"
and Q''Trans: "Q'' ⟼α ≺ Q'''"
and Q'''Chain: "Q''' ⟹⇩τ Q'"
by(blast dest: transitionE)
from QChain PRelQ Sim have "∃P''. P ⟹⇩τ P'' ∧ (P'', Q'') ∈ Rel"
by(rule weakSimTauChain)
then obtain P'' where PChain: "P ⟹⇩τ P''" and P''RelQ'': "(P'', Q'') ∈ Rel" by blast
from P''RelQ'' have "P'' ↝<Rel> Q''" by(rule Sim)
with Q''Trans obtain P''' where P''Trans: "P'' ⟹⇧^α ≺ P'''"
and P'''RelQ''': "(P''', Q''') ∈ Rel"
by(blast dest: simE)
have "∃P'. P''' ⟹⇩τ P' ∧ (P', Q') ∈ Rel" using Q'''Chain P'''RelQ''' Sim
by(rule weakSimTauChain)
then obtain P' where P'''Chain: "P''' ⟹⇩τ P'" and P'RelQ': "(P', Q') ∈ Rel" by blast
from PChain P''Trans P'''Chain have "P ⟹⇧^α ≺ P'"
by(blast dest: chainTransitionAppend)
with P'RelQ' show ?case by blast
next
case Stay
have "P ⟹⇧^τ ≺ P" by simp
thus ?case using PRelQ by blast
qed
qed
lemma eqvtI:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and perm :: "name prm"
assumes PSimQ: "P ↝<Rel> Q"
and RelRel': "Rel ⊆ Rel'"
and EqvtRel': "eqvt Rel'"
shows "(perm ∙ P) ↝<Rel'> (perm ∙ Q)"
proof(induct rule: simCases)
case(Bound Q' a x)
have xFreshP: "x ♯ perm ∙ P" by fact
have QTrans: "(perm ∙ Q) ⟼ a<νx> ≺ Q'" by fact
hence "(rev perm ∙ (perm ∙ Q)) ⟼ rev perm ∙ (a<νx> ≺ Q')" by(rule eqvts)
hence "Q ⟼ (rev perm ∙ a)<ν(rev perm ∙ x)> ≺ (rev perm ∙ Q')"
by(simp add: name_rev_per)
moreover from xFreshP have "(rev perm ∙ x) ♯ P" by(simp add: name_fresh_left)
ultimately obtain P' where PTrans: "P ⟹(rev perm ∙ a)<ν(rev perm ∙ x)> ≺ P'"
and P'RelQ': "(P', rev perm ∙ Q') ∈ Rel" using PSimQ
by(blast dest: simE)
from PTrans have "(perm ∙ P) ⟹(perm ∙ rev perm ∙ a)<ν(perm ∙ rev perm ∙ x)> ≺ perm ∙ P'"
by(rule eqvts)
hence "(perm ∙ P) ⟹a<νx> ≺ (perm ∙ P')" by(simp add: name_per_rev)
moreover from P'RelQ' RelRel' have "(P', rev perm ∙ Q') ∈ Rel'" by blast
with EqvtRel' have "(perm ∙ P', perm ∙ (rev perm ∙ Q')) ∈ Rel'"
by(rule eqvtRelI)
hence "(perm ∙ P', Q') ∈ Rel'" by(simp add: name_per_rev)
ultimately show ?case by blast
next
case(Free Q' α)
have QTrans: "(perm ∙ Q) ⟼ α ≺ Q'" by fact
hence "(rev perm ∙ (perm ∙ Q)) ⟼ rev perm ∙ (α ≺ Q')" by(rule eqvts)
hence "Q ⟼ (rev perm ∙ α) ≺ (rev perm ∙ Q')" by(simp add: name_rev_per)
with PSimQ obtain P' where PTrans: "P ⟹⇧^ (rev perm ∙ α) ≺ P'"
and PRel: "(P', (rev perm ∙ Q')) ∈ Rel"
by(blast dest: simE)
from PTrans have "(perm ∙ P) ⟹⇧^ (perm ∙ rev perm ∙ α) ≺ perm ∙ P'"
by(rule Weak_Early_Semantics.eqvtI)
hence L1: "(perm ∙ P) ⟹⇧^ α ≺ (perm ∙ P')" by(simp add: name_per_rev)
from PRel EqvtRel' RelRel' have "((perm ∙ P'), (perm ∙ (rev perm ∙ Q'))) ∈ Rel'"
by(force intro: eqvtRelI)
hence "((perm ∙ P'), Q') ∈ Rel'" by(simp add: name_per_rev)
with L1 show ?case by blast
qed
lemma reflexive:
fixes P :: pi
and Rel :: "(pi × pi) set"
assumes "Id ⊆ Rel"
shows "P ↝<Rel> P"
using assms
by(auto intro: Weak_Early_Step_Semantics.singleActionChain
simp add: weakSimulation_def weakFreeTransition_def)
lemma transitive:
fixes P :: pi
and Q :: pi
and R :: pi
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
and Rel'' :: "(pi × pi) set"
assumes QSimR: "Q ↝<Rel'> R"
and Eqvt: "eqvt Rel"
and Eqvt'': "eqvt Rel''"
and Trans: "Rel O Rel' ⊆ Rel''"
and Sim: "⋀S T. (S, T) ∈ Rel ⟹ S ↝<Rel> T"
and PRelQ: "(P, Q) ∈ Rel"
shows "P ↝<Rel''> R"
proof -
from Eqvt'' show ?thesis
proof(induct rule: simCasesCont[where C=Q])
case(Bound a x R')
have RTrans: "R ⟼a<νx> ≺ R'" by fact
from ‹x ♯ Q› QSimR RTrans obtain Q' where QTrans: "Q ⟹a<νx> ≺ Q'"
and Q'Rel'R': "(Q', R') ∈ Rel'"
by(blast dest: simE)
from Sim Eqvt PRelQ QTrans ‹x ♯ P›
obtain P' where PTrans: "P ⟹a<νx> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(drule_tac simE2) auto
moreover from P'RelQ' Q'Rel'R' Trans have "(P', R') ∈ Rel''" by blast
ultimately show ?case by blast
next
case(Free α R')
have RTrans: "R ⟼ α ≺ R'" by fact
with QSimR obtain Q' where QTrans: "Q ⟹⇧^ α ≺ Q'" and Q'RelR': "(Q', R') ∈ Rel'"
by(blast dest: simE)
from Sim Eqvt PRelQ QTrans have "∃P'. P ⟹⇧^ α ≺ P' ∧ (P', Q') ∈ Rel"
by(blast intro: simE2)
then obtain P' where PTrans: "P ⟹⇧^ α ≺ P'" and P'RelQ': "(P', Q') ∈ Rel" by blast
from P'RelQ' Q'RelR' Trans have "(P', R') ∈ Rel''" by blast
with PTrans show ?case by blast
qed
qed
lemma strongAppend:
fixes P :: pi
and Q :: pi
and R :: pi
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
and Rel'' :: "(pi × pi) set"
assumes PSimQ: "P ↝<Rel> Q"
and QSimR: "Q ↝[Rel'] R"
and Eqvt'': "eqvt Rel''"
and Trans: "Rel O Rel' ⊆ Rel''"
shows "P ↝<Rel''> R"
proof -
from Eqvt'' show ?thesis
proof(induct rule: simCasesCont[where C=Q])
case(Bound a x R')
have RTrans: "R ⟼a<νx> ≺ R'" by fact
from QSimR RTrans ‹x ♯ Q› obtain Q' where QTrans: "Q ⟼a<νx> ≺ Q'"
and Q'Rel'R': "(Q', R') ∈ Rel'"
by(blast dest: Strong_Early_Sim.elim)
with PSimQ QTrans ‹x ♯ P› obtain P' where PTrans: "P ⟹a<νx> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
moreover from P'RelQ' Q'Rel'R' Trans have "(P', R') ∈ Rel''" by blast
ultimately show ?case by blast
next
case(Free α R')
have RTrans: "R ⟼ α ≺ R'" by fact
with QSimR obtain Q' where QTrans: "Q ⟼α ≺ Q'" and Q'RelR': "(Q', R') ∈ Rel'"
by(blast dest: Strong_Early_Sim.elim)
from PSimQ QTrans obtain P' where PTrans: "P ⟹⇧^ α ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from P'RelQ' Q'RelR' Trans have "(P', R') ∈ Rel''" by blast
with PTrans show ?case by blast
qed
qed
lemma strongSimWeakSim:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
assumes PSimQ: "P ↝[Rel] Q"
shows "P ↝<Rel> Q"
proof(induct rule: simCases)
case(Bound Q' a x)
have "Q ⟼a<νx> ≺ Q'" by fact
with PSimQ ‹x ♯ P› obtain P' where PTrans: "P ⟼a<νx> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: Strong_Early_Sim.elim)
from PTrans have "P ⟹a<νx> ≺ P'"
by(force intro: Weak_Early_Step_Semantics.singleActionChain simp add: weakFreeTransition_def)
with P'RelQ' show ?case by blast
next
case(Free Q' α)
have "Q ⟼α ≺ Q'" by fact
with PSimQ obtain P' where PTrans: "P ⟼α ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: Strong_Early_Sim.elim)
from PTrans have "P ⟹⇧^α ≺ P'" by(rule Weak_Early_Semantics.singleActionChain)
with P'RelQ' show ?case by blast
qed
end
Theory Weak_Early_Bisim
theory Weak_Early_Bisim
imports Weak_Early_Sim Strong_Early_Bisim
begin
lemma monoAux: "A ⊆ B ⟹ P ↝<A> Q ⟶ P ↝<B> Q"
by(auto intro: Weak_Early_Sim.monotonic)
coinductive_set weakBisim :: "(pi × pi) set"
where
step: "⟦P ↝<weakBisim> Q; (Q, P) ∈ weakBisim⟧ ⟹ (P, Q) ∈ weakBisim"
monos monoAux
abbreviation weakEarlyBisimJudge (infixr "≈" 65) where "P ≈ Q ≡ (P, Q) ∈ weakBisim"
lemma weakBisimCoinductAux[case_names weakBisim, case_conclusion weakBisim step, consumes 1]:
assumes p: "(P, Q) ∈ X"
and step: "⋀P Q. (P, Q) ∈ X ⟹ P ↝<(X ∪ weakBisim)> Q ∧ (Q, P) ∈ X ∪ weakBisim"
shows "P ≈ Q"
proof -
have aux: "X ∪ weakBisim = {(P, Q). (P, Q) ∈ X ∨ P ≈ Q}" by blast
from p show ?thesis
by(coinduct, force dest: step simp add: aux)
qed
lemma weakBisimWeakCoinductAux[case_names weakBisim, case_conclusion weakBisim step, consumes 1]:
assumes p: "(P, Q) ∈ X"
and step: "⋀P Q. (P, Q) ∈ X ⟹ P ↝<X> Q ∧ (Q, P) ∈ X"
shows "P ≈ Q"
using p
proof(coinduct rule: weakBisimCoinductAux)
case (weakBisim P)
from step[OF this] show ?case using Weak_Early_Sim.monotonic by blast
qed
lemma weakBisimCoinduct[consumes 1, case_names cSim cSym]:
fixes P :: pi
and Q :: pi
and X :: "(pi × pi) set"
assumes "(P, Q) ∈ X"
and "⋀R S. (R, S) ∈ X ⟹ R ↝<(X ∪ weakBisim)> S"
and "⋀R S. (R, S) ∈ X ⟹ (S, R) ∈ X"
shows "P ≈ Q"
using assms
by(coinduct rule: weakBisimCoinductAux) auto
lemma weakBisimWeakCoinduct[consumes 1, case_names cSim cSym]:
fixes P :: pi
and Q :: pi
and X :: "(pi × pi) set"
assumes "(P, Q) ∈ X"
and "⋀P Q. (P, Q) ∈ X ⟹ P ↝<X> Q"
and "⋀P Q. (P, Q) ∈ X ⟹ (Q, P) ∈ X"
shows "P ≈ Q"
using assms
by(coinduct rule: weakBisimWeakCoinductAux) auto
lemma weakBisimE:
fixes P :: pi
and Q :: pi
assumes "P ≈ Q"
shows "P ↝<weakBisim> Q"
and "Q ≈ P"
using assms
by(auto dest: weakBisim.cases)
lemma weakBisimI:
fixes P :: pi
and Q :: pi
assumes "P ↝<weakBisim> Q"
and "Q ≈ P"
shows "P ≈ Q"
using assms
by(auto intro: weakBisim.intros)
lemma eqvt[simp]:
shows "eqvt weakBisim"
proof(auto simp add: eqvt_def)
let ?X = "{x. ∃P Q (perm::name prm). P ≈ Q ∧ x = (perm ∙ P, perm ∙ Q)}"
fix P Q
fix perm::"name prm"
assume PBiSimQ: "P ≈ Q"
hence "(perm ∙ P, perm ∙ Q) ∈ ?X" by blast
moreover have "⋀P Q perm::name prm. ⟦P ↝<weakBisim> Q⟧ ⟹ (perm ∙ P) ↝<?X> (perm ∙ Q)"
proof -
fix P Q
fix perm::"name prm"
assume "P ↝<weakBisim> Q"
moreover have "weakBisim ⊆ ?X"
proof(auto)
fix P Q
assume "P ≈ Q"
moreover have "P = ([]::name prm) ∙ P" and "Q = ([]::name prm) ∙ Q" by auto
ultimately show "∃P' Q'. P' ≈ Q' ∧ (∃(perm::name prm). P = perm ∙ P' ∧ Q = perm ∙ Q')"
by blast
qed
moreover have "eqvt ?X"
proof(auto simp add: eqvt_def)
fix P Q
fix perm1::"name prm"
fix perm2::"name prm"
assume "P ≈ Q"
moreover have "perm1 ∙ perm2 ∙ P = (perm1 @ perm2) ∙ P" by(simp add: pt2[OF pt_name_inst])
moreover have "perm1 ∙ perm2 ∙ Q = (perm1 @ perm2) ∙ Q" by(simp add: pt2[OF pt_name_inst])
ultimately show "∃P' Q'. P' ≈ Q' ∧ (∃(perm::name prm). perm1 ∙ perm2 ∙ P = perm ∙ P' ∧
perm1 ∙ perm2 ∙ Q = perm ∙ Q')"
by blast
qed
ultimately show "(perm ∙ P) ↝<?X> (perm ∙ Q)"
by(rule Weak_Early_Sim.eqvtI)
qed
ultimately show "(perm ∙ P) ≈ (perm ∙ Q)" by(coinduct rule: weakBisimWeakCoinductAux, blast dest: weakBisimE)
qed
lemma eqvtI[eqvt]:
fixes P :: pi
and Q :: pi
and perm :: "name prm"
assumes "P ≈ Q"
shows "(perm ∙ P) ≈ (perm ∙ Q)"
using assms
by(rule eqvtRelI[OF eqvt])
lemma strongBisimWeakBisim:
fixes P :: pi
and Q :: pi
assumes "P ∼ Q"
shows "P ≈ Q"
proof -
from ‹P ∼ Q› show ?thesis
proof(coinduct rule: weakBisimWeakCoinduct)
case(cSim P Q)
from ‹P ∼ Q› have "P ↝[bisim] Q" by(rule bisimE)
thus "P ↝<bisim> Q" by(rule strongSimWeakSim)
next
case(cSym P Q)
thus ?case by(rule bisimE)
qed
qed
lemma reflexive:
fixes P :: pi
shows "P ≈ P"
proof -
have "(P, P) ∈ Id" by simp
thus ?thesis
by(coinduct rule: weakBisimCoinduct) (auto intro: Weak_Early_Sim.reflexive)
qed
lemma symetric:
fixes P :: pi
and Q :: pi
assumes "P ≈ Q"
shows "Q ≈ P"
using assms
by(auto dest: weakBisimE)
lemma transitive:
fixes P :: pi
and Q :: pi
and R :: pi
assumes "P ≈ Q"
and "Q ≈ R"
shows "P ≈ R"
proof -
let ?X = "weakBisim O weakBisim"
from assms have "(P, R) ∈ ?X" by blast
thus ?thesis
proof(coinduct rule: weakBisimCoinduct)
case(cSim P R)
from ‹(P, R) ∈ ?X› obtain Q where "P ≈ Q" and "Q ≈ R" by auto
from ‹Q ≈ R› have "Q ↝<weakBisim> R" by(rule weakBisimE)
moreover have "eqvt ?X" by auto
moreover have "?X ⊆ ?X" by simp
ultimately show "P ↝<(?X ∪ weakBisim)> R" using weakBisimE(1) ‹P ≈ Q›
by(rule_tac Weak_Early_Sim.transitive) auto
next
case(cSym P R)
thus ?case by(auto dest: symetric)
qed
qed
lemma weakBisimWeakUpto[case_names cSim cSym, consumes 1]:
assumes p: "(P, Q) ∈ X"
and Eqvt: "eqvt X"
and rSim: "⋀P Q. (P, Q) ∈ X ⟹ P ↝<(weakBisim O X O bisim)> Q"
and rSym: "⋀ P Q. (P, Q) ∈ X ⟹ (Q, P) ∈ X"
shows "P ≈ Q"
proof -
let ?X = "weakBisim O X O weakBisim"
let ?Y = "weakBisim O X O bisim"
from Eqvt eqvt have "eqvt ?X" by blast
from Strong_Early_Bisim.eqvt Eqvt eqvt have "eqvt ?Y" by blast
from ‹(P, Q) ∈ X› have "(P, Q) ∈ ?X" by(blast intro: Strong_Early_Bisim.reflexive reflexive)
thus ?thesis
proof(coinduct rule: weakBisimWeakCoinduct)
case(cSim P Q)
{
fix P P' Q' Q
assume "P ≈ P'" and "(P', Q') ∈ X" and "Q' ≈ Q"
from ‹Q' ≈ Q› have "Q' ↝<weakBisim> Q" by(rule weakBisimE)
moreover note ‹eqvt ?Y› ‹eqvt ?X›
moreover have "?Y O weakBisim ⊆ ?X" by(blast dest: strongBisimWeakBisim transitive)
moreover {
fix P Q
assume "(P, Q) ∈ ?Y"
then obtain P' Q' where "P ≈ P'" and "(P', Q') ∈ X" and "Q' ∼ Q" by auto
from ‹(P', Q') ∈ X› have "P' ↝<?Y> Q'" by(rule rSim)
moreover from ‹Q' ∼ Q› have "Q' ↝[bisim] Q" by(rule bisimE)
moreover note ‹eqvt ?Y›
moreover have "?Y O bisim ⊆ ?Y" by(auto dest: Strong_Early_Bisim.transitive)
ultimately have "P' ↝<?Y> Q" by(rule strongAppend)
moreover note ‹P ≈ P'›
moreover have "weakBisim O ?Y ⊆ ?Y" by(blast dest: transitive)
ultimately have "P ↝<?Y> Q" using weakBisimE(1) eqvt ‹eqvt ?Y›
by(rule_tac Weak_Early_Sim.transitive)
}
moreover from ‹(P', Q') ∈ X› have "(P', Q') ∈ ?Y" by(blast intro: reflexive Strong_Early_Bisim.reflexive)
ultimately have "P' ↝<?X> Q" by(rule Weak_Early_Sim.transitive)
moreover note ‹P ≈ P'›
moreover have "weakBisim O ?X ⊆ ?X" by(blast dest: transitive)
ultimately have "P ↝<?X> Q" using weakBisimE(1) eqvt ‹eqvt ?X›
by(rule_tac Weak_Early_Sim.transitive)
}
with ‹(P, Q) ∈ ?X› show ?case by auto
next
case(cSym P Q)
thus ?case
apply auto
by(blast dest: bisimE rSym weakBisimE)
qed
qed
lemma weakBisimUpto[case_names cSim cSym, consumes 1]:
assumes p: "(P, Q) ∈ X"
and Eqvt: "eqvt X"
and rSim: "⋀R S. (R, S) ∈ X ⟹ R ↝<(weakBisim O (X ∪ weakBisim) O bisim)> S"
and rSym: "⋀R S. (R, S) ∈ X ⟹ (S, R) ∈ X"
shows "P ≈ Q"
proof -
from p have "(P, Q) ∈ X ∪ weakBisim" by simp
thus ?thesis using Eqvt
apply(coinduct rule: weakBisimWeakUpto)
apply(auto dest: rSim rSym weakBisimE)
apply(rule Weak_Early_Sim.monotonic)
apply(blast dest: weakBisimE)
apply(auto simp add: relcomp_unfold)
by(metis reflexive Strong_Early_Bisim.reflexive transitive)
qed
lemma transitive_coinduct_weak[case_names cSim cSym, consumes 2]:
assumes p: "(P, Q) ∈ X"
and Eqvt: "eqvt X"
and rSim: "⋀P Q. (P, Q) ∈ X ⟹ P ↝<(bisim O X O bisim)> Q"
and rSym: "⋀ P Q. (P, Q) ∈ X ⟹ (Q, P) ∈ bisim O X O bisim"
shows "P ≈ Q"
proof -
let ?X = "bisim O X O bisim"
from ‹(P, Q) ∈ X› have "(P, Q) ∈ ?X" by(blast intro: Strong_Early_Bisim.reflexive)
thus ?thesis
proof(coinduct rule: weakBisimWeakCoinduct)
case(cSim P Q)
{
fix P P' Q' Q
assume PBisimP': "P ∼ P'"
assume P'SimQ': "P' ↝<?X> Q'"
assume Q'SimQ: "Q' ↝[bisim] Q"
have "P ↝<?X> Q"
proof -
have "P' ↝<?X> Q"
proof -
have "?X O bisim ⊆ ?X" by(blast intro: Strong_Early_Bisim.transitive)
moreover from Strong_Early_Bisim.eqvt Eqvt have "eqvt ?X" by blast
ultimately show ?thesis using P'SimQ' Q'SimQ
by(rule_tac strongAppend)
qed
moreover have "eqvt bisim" by(rule Strong_Early_Bisim.eqvt)
moreover from Strong_Early_Bisim.eqvt Eqvt have "eqvt ?X" by blast
moreover have "bisim O ?X ⊆ ?X" by(blast intro: Strong_Early_Bisim.transitive)
moreover have "⋀P Q. P ∼ Q ⟹ P ↝<bisim> Q" by(blast dest: Strong_Early_Bisim.bisimE strongSimWeakSim)
ultimately show ?thesis using PBisimP' by(rule Weak_Early_Sim.transitive)
qed
}
thus ?case using ‹(P, Q) ∈ ?X› rSim by (blast dest: Strong_Early_Bisim.bisimE)
next
case(cSym P Q)
{
fix P P' Q' Q
assume "P ∼ P'" and "(P', Q') ∈ X" and "Q' ∼ Q"
from ‹(P', Q') ∈ X› have "(Q', P') ∈ ?X" by(rule rSym)
with ‹P ∼ P'› ‹Q' ∼ Q› have "(Q, P) ∈ ?X"
apply auto
apply(drule_tac Strong_Early_Bisim.bisimE(2))
apply(drule Strong_Early_Bisim.transitive[where Q=P'])
apply assumption
apply(drule_tac Strong_Early_Bisim.bisimE(2))
apply(drule Strong_Early_Bisim.transitive[where Q=Q'])
apply assumption
by auto
}
thus ?case using ‹(P, Q) ∈ ?X› by auto
qed
qed
end
Theory Weak_Early_Step_Sim
theory Weak_Early_Step_Sim
imports Weak_Early_Sim Strong_Early_Sim
begin
definition weakStepSimulation :: "pi ⇒ (pi × pi) set ⇒ pi ⇒ bool" ("_ ↝«_» _" [80, 80, 80] 80) where
"P ↝«Rel» Q ≡ (∀Q' a x. Q ⟼a<νx> ≺ Q' ⟶ x ♯ P ⟶ (∃P' . P ⟹a<νx> ≺ P' ∧ (P', Q') ∈ Rel)) ∧
(∀Q' α. Q ⟼α ≺ Q' ⟶ (∃P'. P ⟹α ≺ P' ∧ (P', Q') ∈ Rel))"
lemma monotonic:
fixes A :: "(pi × pi) set"
and B :: "(pi × pi) set"
and P :: pi
and P' :: pi
assumes "P ↝«A» P'"
and "A ⊆ B"
shows "P ↝«B» P'"
using assms
by(simp add: weakStepSimulation_def) blast
lemma simCasesCont[consumes 1, case_names Bound Free]:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and C :: "'a::fs_name"
assumes Eqvt: "eqvt Rel"
and Bound: "⋀a x Q'. ⟦x ♯ C; Q ⟼ a<νx> ≺ Q'⟧ ⟹ ∃P'. P ⟹ a<νx> ≺ P' ∧ (P', Q') ∈ Rel"
and Free: "⋀α Q'. Q ⟼ α ≺ Q' ⟹ ∃P'. P ⟹ α ≺ P' ∧ (P', Q') ∈ Rel"
shows "P ↝«Rel» Q"
proof -
from Free show ?thesis
proof(auto simp add: weakStepSimulation_def)
fix Q' a x
assume xFreshP: "(x::name) ♯ P"
assume Trans: "Q ⟼ a<νx> ≺ Q'"
have "∃c::name. c ♯ (P, Q', x, C)" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshP: "c ♯ P" and cFreshQ': "c ♯ Q'" and cFreshC: "c ♯ C"
and cineqx: "c ≠ x"
by(force simp add: fresh_prod)
from Trans cFreshQ' have "Q ⟼ a<νc> ≺ ([(x, c)] ∙ Q')" by(simp add: alphaBoundOutput)
with cFreshC have "∃P'. P ⟹ a<νc> ≺ P' ∧ (P', [(x, c)] ∙ Q') ∈ Rel"
by(rule Bound)
then obtain P' where PTrans: "P ⟹ a<νc> ≺ P'" and P'RelQ': "(P', [(x, c)] ∙ Q') ∈ Rel"
by blast
from PTrans ‹x ♯ P› ‹c ≠ x› have "P ⟹a<νx> ≺ ([(x, c)] ∙ P')"
by(simp add: weakTransitionAlpha name_swap)
moreover from Eqvt P'RelQ' have "([(x, c)] ∙ P', [(x, c)] ∙ [(x, c)] ∙ Q') ∈ Rel"
by(rule eqvtRelI)
with ‹c ≠ x› have "([(x, c)] ∙ P', Q') ∈ Rel"
by simp
ultimately show "∃P'. P ⟹a<νx> ≺ P' ∧ (P', Q') ∈ Rel" by blast
qed
qed
lemma simCases[consumes 0, case_names Bound Free]:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and C :: "'a::fs_name"
assumes "⋀a x Q'. ⟦Q ⟼ a<νx> ≺ Q'; x ♯ P⟧ ⟹ ∃P'. P ⟹ a<νx> ≺ P' ∧ (P', Q') ∈ Rel"
and "⋀α Q'. Q ⟼ α ≺ Q' ⟹ ∃P'. P ⟹ α ≺ P' ∧ (P', Q') ∈ Rel"
shows "P ↝«Rel» Q"
using assms
by(auto simp add: weakStepSimulation_def)
lemma simE:
fixes P :: pi
and Rel :: "(pi × pi) set"
and Q :: pi
and a :: name
and x :: name
and Q' :: pi
assumes "P ↝«Rel» Q"
shows "Q ⟼a<νx> ≺ Q' ⟹ x ♯ P ⟹ ∃P'. P ⟹a<νx> ≺ P' ∧ (P', Q') ∈ Rel"
and "Q ⟼α ≺ Q' ⟹ ∃P'. P ⟹α ≺ P' ∧ (P', Q') ∈ Rel"
using assms by(simp add: weakStepSimulation_def)+
lemma simE2:
fixes P :: pi
and Rel :: "(pi × pi) set"
and Q :: pi
and a :: name
and x :: name
and Q' :: pi
assumes PSimQ: "P ↝«Rel» Q"
and Sim: "⋀R S. (R, S) ∈ Rel ⟹ R ↝<Rel> S"
and Eqvt: "eqvt Rel"
and PRelQ: "(P, Q) ∈ Rel"
shows "Q ⟹a<νx> ≺ Q' ⟹ x ♯ P ⟹ ∃P'. P ⟹a<νx> ≺ P' ∧ (P', Q') ∈ Rel"
and "Q ⟹α ≺ Q' ⟹ ∃P'. P ⟹α ≺ P' ∧ (P', Q') ∈ Rel"
proof -
assume QTrans: "Q ⟹a<νx> ≺ Q'"
assume "x ♯ P"
from QTrans obtain Q'' Q''' where QChain: "Q ⟹⇩τ Q''"
and Q''Trans: "Q'' ⟼a<νx> ≺ Q'''"
and Q'''Chain: "Q''' ⟹⇩τ Q'"
by(blast dest: transitionE)
from QChain PRelQ Sim have "∃P''. P ⟹⇩τ P'' ∧ (P'', Q'') ∈ Rel"
by(rule weakSimTauChain)
then obtain P'' where PChain: "P ⟹⇩τ P''" and P''RelQ'': "(P'', Q'') ∈ Rel" by blast
from PChain ‹x ♯ P› have xFreshP'': "x ♯ P''" by(rule freshChain)
from P''RelQ'' have "P'' ↝<Rel> Q''" by(rule Sim)
with Q''Trans xFreshP'' obtain P''' where P''Trans: "P'' ⟹a<νx> ≺ P'''"
and P'''RelQ''': "(P''', Q''') ∈ Rel"
by(blast dest: Weak_Early_Sim.simE)
have "∃P'. P''' ⟹⇩τ P' ∧ (P', Q') ∈ Rel" using Q'''Chain P'''RelQ''' Sim
by(rule weakSimTauChain)
then obtain P' where P'''Chain: "P''' ⟹⇩τ P'" and P'RelQ': "(P', Q') ∈ Rel" by blast
from PChain P''Trans P'''Chain have "P ⟹a<νx> ≺ P'"
by(blast dest: Weak_Early_Step_Semantics.chainTransitionAppend)
with P'RelQ' show "∃P'. P ⟹ a<νx> ≺ P' ∧ (P', Q') ∈ Rel"
by blast
next
assume "Q ⟹α ≺ Q'"
then obtain Q'' Q''' where QChain: "Q ⟹⇩τ Q''"
and Q''Trans: "Q'' ⟼α ≺ Q'''"
and Q'''Chain: "Q''' ⟹⇩τ Q'"
by(blast dest: transitionE)
from QChain Q''Trans Q'''Chain show "∃P'. P ⟹α ≺ P' ∧ (P', Q') ∈ Rel"
proof(induct arbitrary: α Q''' Q' rule: tauChainInduct)
case id
from PSimQ ‹Q ⟼α ≺ Q'''› have "∃P'. P ⟹α ≺ P' ∧ (P', Q''') ∈ Rel"
by(blast dest: simE)
then obtain P''' where PTrans: "P ⟹α ≺ P'''" and P'RelQ''': "(P''', Q''') ∈ Rel"
by blast
have "∃P'. P''' ⟹⇩τ P' ∧ (P', Q') ∈ Rel" using ‹Q''' ⟹⇩τ Q'› P'RelQ''' Sim
by(rule Weak_Early_Sim.weakSimTauChain)
then obtain P' where P'''Chain: "P''' ⟹⇩τ P'" and P'RelQ': "(P', Q') ∈ Rel" by blast
from P'''Chain PTrans have "P ⟹α ≺ P'"
by(blast dest: Weak_Early_Step_Semantics.chainTransitionAppend)
with P'RelQ' show ?case by blast
next
case(ih Q'''' Q'' α Q''' Q')
have "Q'' ⟹⇩τ Q''" by simp
with ‹Q'''' ⟼τ ≺ Q''› obtain P'' where PChain: "P ⟹τ ≺ P''" and P''RelQ'': "(P'', Q'') ∈ Rel"
by(drule_tac ih) auto
from P''RelQ'' have "P'' ↝<Rel> Q''" by(rule Sim)
hence "∃P'''. P'' ⟹⇧^α ≺ P''' ∧ (P''', Q''') ∈ Rel" using ‹Q'' ⟼α ≺ Q'''›
by(rule Weak_Early_Sim.simE)
then obtain P''' where P''Trans: "P'' ⟹⇧^α ≺ P'''"
and P'''RelQ''': "(P''', Q''') ∈ Rel"
by blast
from ‹Q''' ⟹⇩τ Q'› P'''RelQ''' Sim have "∃P'. P''' ⟹⇩τ P' ∧ (P', Q') ∈ Rel"
by(rule Weak_Early_Sim.weakSimTauChain)
then obtain P' where P'''Chain: "P''' ⟹⇩τ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by blast
from PChain P''Trans have "P ⟹α ≺ P'''"
apply(auto simp add: freeTransition_def weakFreeTransition_def)
apply(drule tauActTauChain, auto)
by(rule_tac x=P'''aa in exI) auto
hence "P ⟹α ≺ P'" using P'''Chain
by(rule Weak_Early_Step_Semantics.chainTransitionAppend)
with P'RelQ' show ?case by blast
qed
qed
lemma eqvtI:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and perm :: "name prm"
assumes PSimQ: "P ↝«Rel» Q"
and RelRel': "Rel ⊆ Rel'"
and EqvtRel': "eqvt Rel'"
shows "(perm ∙ P) ↝«Rel'» (perm ∙ Q)"
proof(induct rule: simCases)
case(Bound a x Q')
have xFreshP: "x ♯ perm ∙ P" by fact
have QTrans: "(perm ∙ Q) ⟼ a<νx> ≺ Q'" by fact
hence "(rev perm ∙ (perm ∙ Q)) ⟼ rev perm ∙ (a<νx> ≺ Q')" by(rule eqvt)
hence "Q ⟼ (rev perm ∙ a)<ν(rev perm ∙ x)> ≺ (rev perm ∙ Q')"
by(simp add: name_rev_per)
moreover from xFreshP have "(rev perm ∙ x) ♯ P" by(simp add: name_fresh_left)
ultimately obtain P' where PTrans: "P ⟹ (rev perm ∙ a)<ν(rev perm ∙ x)> ≺ P'"
and P'RelQ': "(P', rev perm ∙ Q') ∈ Rel" using PSimQ
by(blast dest: simE)
from PTrans have "(perm ∙ P) ⟹(perm ∙ rev perm ∙ a)<ν(perm ∙ rev perm ∙ x)> ≺ perm ∙ P'"
by(rule Weak_Early_Step_Semantics.eqvtI)
hence L1: "(perm ∙ P) ⟹ a<νx> ≺ (perm ∙ P')" by(simp add: name_per_rev)
from P'RelQ' RelRel' have "(P', rev perm ∙ Q') ∈ Rel'" by blast
with EqvtRel' have "(perm ∙ P', perm ∙ (rev perm ∙ Q')) ∈ Rel'"
by(rule eqvtRelI)
hence "(perm ∙ P', Q') ∈ Rel'" by(simp add: name_per_rev)
with L1 show ?case by blast
next
case(Free α Q')
have QTrans: "(perm ∙ Q) ⟼ α ≺ Q'" by fact
hence "(rev perm ∙ (perm ∙ Q)) ⟼ rev perm ∙ (α ≺ Q')" by(rule eqvts)
hence "Q ⟼ (rev perm ∙ α) ≺ (rev perm ∙ Q')" by(simp add: name_rev_per)
with PSimQ obtain P' where PTrans: "P ⟹ (rev perm ∙ α) ≺ P'"
and PRel: "(P', (rev perm ∙ Q')) ∈ Rel"
by(blast dest: simE)
from PTrans have "(perm ∙ P) ⟹(perm ∙ rev perm ∙ α) ≺ perm ∙ P'"
by(rule Weak_Early_Step_Semantics.eqvtI)
hence L1: "(perm ∙ P) ⟹ α ≺ (perm ∙ P')" by(simp add: name_per_rev)
from PRel EqvtRel' RelRel' have "((perm ∙ P'), (perm ∙ (rev perm ∙ Q'))) ∈ Rel'"
by(force intro: eqvtRelI)
hence "((perm ∙ P'), Q') ∈ Rel'" by(simp add: name_per_rev)
with L1 show ?case by blast
qed
lemma reflexive:
fixes P :: pi
and Rel :: "(pi × pi) set"
assumes "Id ⊆ Rel"
shows "P ↝«Rel» P"
using assms
by(auto intro: Weak_Early_Step_Semantics.singleActionChain
simp add: weakStepSimulation_def weakFreeTransition_def)
lemma transitive:
fixes P :: pi
and Q :: pi
and R :: pi
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
and Rel'' :: "(pi × pi) set"
assumes PSimQ: "P ↝«Rel» Q"
and QSimR: "Q ↝«Rel'» R"
and Eqvt: "eqvt Rel"
and Eqvt'': "eqvt Rel''"
and Trans: "Rel O Rel' ⊆ Rel''"
and Sim: "⋀S T. (S, T) ∈ Rel ⟹ S ↝<Rel> T"
and PRelQ: "(P, Q) ∈ Rel"
shows "P ↝«Rel''» R"
proof -
from Eqvt'' show ?thesis
proof(induct rule: simCasesCont[of _ "(P, Q)"])
case(Bound a x R')
have "x ♯ (P, Q)" by fact
hence xFreshP: "x ♯ P" and xFreshQ: "x ♯ Q" by(simp add: fresh_prod)+
have RTrans: "R ⟼a<νx> ≺ R'" by fact
from xFreshQ QSimR RTrans obtain Q' where QTrans: "Q ⟹ a<νx> ≺ Q'"
and Q'Rel'R': "(Q', R') ∈ Rel'"
by(blast dest: simE)
with PSimQ Sim Eqvt PRelQ QTrans xFreshP have "∃P'. P ⟹ a<νx> ≺ P' ∧ (P', Q') ∈ Rel"
by(blast intro: simE2)
then obtain P' where PTrans: "P ⟹ a<νx> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel" by blast
moreover from P'RelQ' Q'Rel'R' Trans have "(P', R') ∈ Rel''" by blast
ultimately show ?case by blast
next
case(Free α R')
have RTrans: "R ⟼ α ≺ R'" by fact
with QSimR obtain Q' where QTrans: "Q ⟹ α ≺ Q'" and Q'RelR': "(Q', R') ∈ Rel'"
by(blast dest: simE)
from PSimQ Sim Eqvt PRelQ QTrans have "∃P'. P ⟹ α ≺ P' ∧ (P', Q') ∈ Rel"
by(blast intro: simE2)
then obtain P' where PTrans: "P ⟹ α ≺ P'" and P'RelQ': "(P', Q') ∈ Rel" by blast
from P'RelQ' Q'RelR' Trans have "(P', R') ∈ Rel''" by blast
with PTrans show ?case by blast
qed
qed
lemma strongSimWeakSim:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
assumes PSimQ: "P ↝[Rel] Q"
shows "P ↝«Rel» Q"
proof(induct rule: simCases)
case(Bound a x Q')
have "Q ⟼a<νx> ≺ Q'" and "x ♯ P" by fact+
with PSimQ obtain P' where PTrans: "P ⟼a<νx> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: Strong_Early_Sim.elim)
from PTrans have "P ⟹a<νx> ≺ P'"
by(force intro: Weak_Early_Step_Semantics.singleActionChain simp add: weakFreeTransition_def)
with P'RelQ' show ?case by blast
next
case(Free α Q')
have "Q ⟼α ≺ Q'" by fact
with PSimQ obtain P' where PTrans: "P ⟼α ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: Strong_Early_Sim.elim)
from PTrans have "P ⟹α ≺ P'" by(rule Weak_Early_Step_Semantics.singleActionChain)
with P'RelQ' show ?case by blast
qed
lemma weakSimWeakEqSim:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
assumes "P ↝«Rel» Q"
shows "P ↝<Rel> Q"
using assms
by(force simp add: weakStepSimulation_def Weak_Early_Sim.weakSimulation_def weakFreeTransition_def)
end
Theory Weak_Early_Cong
theory Weak_Early_Cong
imports Weak_Early_Bisim Weak_Early_Step_Sim Strong_Early_Bisim
begin
definition weakCongruence :: "pi ⇒ pi ⇒ bool" (infixr "≃" 65)
where "P ≃ Q ≡ P ↝«weakBisim» Q ∧ Q ↝«weakBisim» P"
lemma weakCongISym[consumes 1, case_names cSym cSim]:
fixes P :: pi
and Q :: pi
assumes "Prop P Q"
and "⋀R S. Prop R S ⟹ Prop S R"
and "⋀R S. Prop R S ⟹ (F R) ↝«weakBisim» (F S)"
shows "F P ≃ F Q"
using assms
by(auto simp add: weakCongruence_def)
lemma weakCongISym2[consumes 1, case_names cSim]:
fixes P :: pi
and Q :: pi
assumes "P ≃ Q"
and "⋀R S. R ≃ S ⟹ (F R) ↝«weakBisim» (F S)"
shows "F P ≃ F Q"
using assms
by(auto simp add: weakCongruence_def)
lemma weakCongEE:
fixes P :: pi
and Q :: pi
and s :: "(name × name) list"
assumes "P ≃ Q"
shows "P ↝«weakBisim» Q"
and "Q ↝«weakBisim» P"
using assms
by(auto simp add: weakCongruence_def)
lemma weakCongI:
fixes P :: pi
and Q :: pi
assumes "P ↝«weakBisim» Q"
and "Q ↝«weakBisim» P"
shows "P ≃ Q"
using assms
by(auto simp add: weakCongruence_def)
lemma eqvtI[eqvt]:
fixes P :: pi
and Q :: pi
and p :: "name prm"
assumes "P ≃ Q"
shows "(p ∙ P) ≃ (p ∙ Q)"
using assms
by(auto simp add: weakCongruence_def intro: eqvtI)
lemma strongBisimWeakCong:
fixes P :: pi
and Q :: pi
assumes "P ∼ Q"
shows "P ≃ Q"
proof -
have "⋀P Q. P ↝[bisim] Q ⟹ P ↝«weakBisim» Q"
proof -
fix P Q
assume "P ↝[bisim] Q"
hence "P ↝«bisim» Q" by(rule Weak_Early_Step_Sim.strongSimWeakSim)
moreover have "bisim ⊆ weakBisim"
by(auto intro: strongBisimWeakBisim)
ultimately show "P ↝«weakBisim» Q" by(rule Weak_Early_Step_Sim.monotonic)
qed
with assms show ?thesis
by(blast intro: weakCongI dest: Strong_Early_Bisim.bisimE)
qed
lemma congruenceWeakBisim:
fixes P :: pi
and Q :: pi
assumes "P ≃ Q"
shows "P ≈ Q"
using assms
proof -
let ?X = "{(P, Q) | P Q. P ≃ Q}"
from assms have "(P, Q) ∈ ?X" by simp
thus ?thesis
proof(induct rule: weakBisimCoinduct)
case(cSim P Q)
{
fix P Q
assume "P ≃ Q"
hence "P ↝«weakBisim» Q" by(simp add: weakCongruence_def)
hence "P ↝«(?X ∪ weakBisim)» Q" by(rule_tac Weak_Early_Step_Sim.monotonic) auto
hence "P ↝<(?X ∪ weakBisim)> Q" by(rule weakSimWeakEqSim)
}
with ‹(P, Q) ∈ ?X› show ?case by auto
next
case(cSym P Q)
thus ?case by(auto simp add: weakCongruence_def)
qed
qed
lemma reflexive:
fixes P :: pi
shows "P ≃ P"
proof -
from Weak_Early_Bisim.reflexive have "⋀P. P ↝«weakBisim» P"
by(blast intro: Weak_Early_Step_Sim.reflexive)
thus ?thesis
by(force simp add: substClosed_def weakCongruence_def)
qed
lemma symetric:
fixes P :: pi
and Q :: pi
assumes "P ≃ Q"
shows "Q ≃ P"
using assms
by(force simp add: substClosed_def weakCongruence_def)
lemma transitive:
fixes P :: pi
and Q :: pi
and R :: pi
assumes "P ≃ Q"
and "Q ≃ R"
shows "P ≃ R"
proof -
have Goal: "⋀P Q R. ⟦P ↝«weakBisim» Q; Q ↝«weakBisim» R; P ≈ Q⟧ ⟹ P ↝«weakBisim» R"
using Weak_Early_Bisim.eqvt Weak_Early_Bisim.weakBisimE Weak_Early_Bisim.transitive
by(blast intro: Weak_Early_Step_Sim.transitive)
from assms show ?thesis
apply(simp add: weakCongruence_def) using assms
by(blast intro: Goal dest: congruenceWeakBisim symetric)
qed
end
Theory Weak_Early_Bisim_Subst
theory Weak_Early_Bisim_Subst
imports Weak_Early_Bisim Strong_Early_Bisim_Subst
begin
consts weakBisimSubst :: "(pi × pi) set"
abbreviation weakEarlyBisimSubstJudge (infixr "≈⇧s" 65) where "P ≈⇧s Q ≡ (P, Q) ∈ (substClosed weakBisim)"
lemma congBisim:
fixes P :: pi
and Q :: pi
assumes "P ≈⇧s Q"
shows "P ≈ Q"
using assms substClosedSubset
by blast
lemma strongBisimWeakBisim:
fixes P :: pi
and Q :: pi
assumes "P ∼⇧s Q"
shows "P ≈⇧s Q"
using assms
by(auto simp add: substClosed_def intro: strongBisimWeakBisim)
lemma eqvt:
shows "eqvt (substClosed weakBisim)"
by(rule eqvtSubstClosed[OF Weak_Early_Bisim.eqvt])
lemma eqvtI[eqvt]:
fixes P :: pi
and Q :: pi
and perm :: "name prm"
assumes "P ≈⇧s Q"
shows "(perm ∙ P) ≈⇧s (perm ∙ Q)"
using assms
by(rule eqvtRelI[OF eqvt])
lemma reflexive:
fixes P :: pi
shows "P ≈⇧s P"
by(force simp add: substClosed_def intro: Weak_Early_Bisim.reflexive)
lemma symetric:
fixes P :: pi
and Q :: pi
assumes "P ≈⇧s Q"
shows "Q ≈⇧s P"
using assms
by(force simp add: substClosed_def intro: Weak_Early_Bisim.symetric)
lemma transitive:
fixes P :: pi
and Q :: pi
and R :: pi
assumes "P ≈⇧s Q"
and "Q ≈⇧s R"
shows "P ≈⇧s R"
using assms
by(force simp add: substClosed_def intro: Weak_Early_Bisim.transitive)
lemma partUnfold:
fixes P :: pi
and Q :: pi
and s :: "(name × name) list"
assumes "P ≈⇧s Q"
shows "P[<s>] ≈⇧s Q[<s>]"
using assms
proof(auto simp add: substClosed_def)
fix s'
assume "∀s. P[<s>] ≈ Q[<s>]"
hence "P[<(s@s')>] ≈ Q[<(s@s')>]" by blast
moreover have "P[<(s@s')>] = (P[<s>])[<s'>]"
by(induct s', auto)
moreover have "Q[<(s@s')>] = (Q[<s>])[<s'>]"
by(induct s', auto)
ultimately show "(P[<s>])[<s'>] ≈ (Q[<s>])[<s'>]"
by simp
qed
end
Theory Weak_Early_Cong_Subst
theory Weak_Early_Cong_Subst
imports Weak_Early_Cong Weak_Early_Bisim_Subst Strong_Early_Bisim_Subst
begin
consts congruenceSubst :: "(pi × pi) set"
definition weakCongruenceSubst (infixr "≃⇧s" 65) where "P ≃⇧s Q ≡ ∀σ. P[<σ>] ≃ Q[<σ>]"
lemma unfoldE:
fixes P :: pi
and Q :: pi
and s :: "(name × name) list"
assumes "P ≃⇧s Q"
shows "P[<s>] ↝«weakBisim» Q[<s>]"
and "Q[<s>] ↝«weakBisim» P[<s>]"
proof -
from assms show "P[<s>] ↝«weakBisim» Q[<s>]" by(simp add: weakCongruenceSubst_def weakCongruence_def)
next
from assms show "Q[<s>] ↝«weakBisim» P[<s>]" by(simp add: weakCongruenceSubst_def weakCongruence_def)
qed
lemma unfoldI:
fixes P :: pi
and Q :: pi
assumes "⋀s. P[<s>] ↝«weakBisim» Q[<s>]"
and "⋀s. Q[<s>] ↝«weakBisim» P[<s>]"
shows "P ≃⇧s Q"
using assms
by(simp add: weakCongruenceSubst_def weakCongruence_def)
lemma weakCongWeakEq:
fixes P :: pi
and Q :: pi
assumes "P ≃⇧s Q"
shows "P ≃ Q"
using assms
apply(simp add: weakCongruenceSubst_def weakCongruence_def)
apply(erule_tac x="[]" in allE)
by auto
lemma eqvtI:
fixes P :: pi
and Q :: pi
and p :: "name prm"
assumes "P ≃⇧s Q"
shows "(p ∙ P) ≃⇧s (p ∙ Q)"
proof(simp add: weakCongruenceSubst_def, rule allI)
fix s
from assms have "P[<(rev p ∙ s)>] ≃ Q[<(rev p ∙ s)>]" by(auto simp add: weakCongruenceSubst_def)
thus "(p ∙ P)[<s>] ≃ (p ∙ Q)[<s>]" by(drule_tac p=p in Weak_Early_Cong.eqvtI) (simp add: eqvts name_per_rev)
qed
lemma strongEqWeakCong:
fixes P :: pi
and Q :: pi
assumes "P ∼⇧s Q"
shows "P ≃⇧s Q"
using assms
by(auto intro: strongBisimWeakCong simp add: substClosed_def weakCongruenceSubst_def)
lemma congSubstBisimSubst:
fixes P :: pi
and Q :: pi
assumes "P ≃⇧s Q"
shows "P ≈⇧s Q"
using assms
by(auto intro: congruenceWeakBisim simp add: substClosed_def weakCongruenceSubst_def)
lemma reflexive:
fixes P :: pi
shows "P ≃⇧s P"
proof -
from Weak_Early_Bisim.reflexive have "⋀P. P ↝«weakBisim» P"
by(blast intro: Weak_Early_Step_Sim.reflexive)
thus ?thesis
by(force simp add: weakCongruenceSubst_def weakCongruence_def)
qed
lemma symetric:
fixes P :: pi
and Q :: pi
assumes "P ≃⇧s Q"
shows "Q ≃⇧s P"
using assms by(auto simp add: weakCongruenceSubst_def weakCongruence_def)
lemma transitive:
fixes P :: pi
and Q :: pi
and R :: pi
assumes "P ≃⇧s Q"
and "Q ≃⇧s R"
shows "P ≃⇧s R"
using assms by(auto simp add: weakCongruenceSubst_def intro: Weak_Early_Cong.transitive)
lemma partUnfold:
fixes P :: pi
and Q :: pi
and s :: "(name × name) list"
assumes "P ≃⇧s Q"
shows "P[<s>] ≃⇧s Q[<s>]"
using assms
proof(auto simp add: weakCongruenceSubst_def)
fix s'
assume "∀s. P[<s>] ≃ Q[<s>]"
hence "P[<(s@s')>] ≃ Q[<(s@s')>]" by blast
moreover have "P[<(s@s')>] = (P[<s>])[<s'>]"
by(induct s', auto)
moreover have "Q[<(s@s')>] = (Q[<s>])[<s'>]"
by(induct s', auto)
ultimately show "(P[<s>])[<s'>] ≃ (Q[<s>])[<s'>]"
by simp
qed
end
Theory Weak_Early_Step_Sim_Pres
theory Weak_Early_Step_Sim_Pres
imports Weak_Early_Step_Sim
begin
lemma tauPres:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes PRelQ: "(P, Q) ∈ Rel"
shows "τ.(P) ↝«Rel» τ.(Q)"
proof(induct rule: simCases)
case(Bound a x Q')
have "τ.(Q) ⟼a<νx> ≺ Q'" by fact
hence False by(induct rule: tauCases', auto)
thus ?case by simp
next
case(Free α Q')
have "τ.(Q) ⟼(α ≺ Q')" by fact
thus ?case
proof(induct rule: tauCases', auto simp add: pi.inject residual.inject)
have "τ.(P) ⟹ τ ≺ P" by(rule Weak_Early_Step_Semantics.Tau)
with PRelQ show "∃P'. τ.(P) ⟹ τ ≺ P' ∧ (P', Q) ∈ Rel" by blast
qed
qed
lemma inputPres:
fixes P :: pi
and x :: name
and Q :: pi
and a :: name
and Rel :: "(pi × pi) set"
assumes PRelQ: "∀y. (P[x::=y], Q[x::=y]) ∈ Rel"
and Eqvt: "eqvt Rel"
shows "a<x>.P ↝«Rel» a<x>.Q"
using Eqvt
proof(induct rule: simCasesCont[where C="(x, a, P, Q)"])
case(Bound b y Q')
from ‹y ♯ (x, a, P, Q)› have "y ≠ x" "y ≠ a" "y ♯ P" "y ♯ Q" by simp+
from ‹a<x>.Q ⟼b<νy> ≺ Q'› ‹y ≠ a› ‹y ≠ x› ‹y ♯ Q› show ?case
by(erule_tac inputCases') auto
next
case(Free α Q')
from ‹a<x>.Q ⟼ α ≺ Q'›
show ?case
proof(induct rule: inputCases)
case(cInput u)
have "a<x>.P ⟹(a<u>) ≺ (P[x::=u])"
by(rule Weak_Early_Step_Semantics.Input)
moreover from PRelQ have "(P[x::=u], Q[x::=u]) ∈ Rel" by auto
ultimately show ?case by blast
qed
qed
lemma outputPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes PRelQ: "(P, Q) ∈ Rel"
shows "a{b}.P ↝«Rel» a{b}.Q"
proof(induct rule: simCases)
case(Bound c x Q')
have "a{b}.Q ⟼c<νx> ≺ Q'" by fact
hence False by(induct rule: outputCases', auto)
thus ?case by simp
next
case(Free α Q')
have "a{b}.Q ⟼α ≺ Q'" by fact
thus "∃P'. a{b}.P ⟹ α ≺ P' ∧ (P', Q') ∈ Rel"
proof(induct rule: outputCases', auto simp add: pi.inject residual.inject)
have "a{b}.P ⟹ a[b] ≺ P" by(rule Weak_Early_Step_Semantics.Output)
with PRelQ show "∃P'. a{b}.P ⟹ a[b] ≺ P' ∧ (P', Q) ∈ Rel" by blast
qed
qed
lemma matchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes PSimQ: "P ↝«Rel» Q"
and RelRel': "Rel ⊆ Rel'"
shows "[a⌢b]P ↝«Rel'» [a⌢b]Q"
proof(induct rule: simCases)
case(Bound c x Q')
have "x ♯ [a⌢b]P" by fact
hence xFreshP: "(x::name) ♯ P" by simp
have "[a⌢b]Q ⟼c<νx> ≺ Q'" by fact
thus ?case
proof(induct rule: matchCases)
case Match
have "Q ⟼c<νx> ≺ Q'" by fact
with PSimQ xFreshP obtain P' where PTrans: "P ⟹c<νx> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans have "[a⌢a]P ⟹c<νx> ≺ P'" by(rule Weak_Early_Step_Semantics.Match)
moreover from P'RelQ' RelRel' have "(P', Q') ∈ Rel'" by blast
ultimately show ?case by blast
qed
next
case(Free α Q')
have "[a⌢b]Q ⟼α ≺ Q'" by fact
thus ?case
proof(induct rule: matchCases)
case Match
have "Q ⟼ α ≺ Q'" by fact
with PSimQ obtain P' where PTrans: "P ⟹α ≺ P'" and PRel: "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans have "[a⌢a]P ⟹α ≺ P'" by(rule Weak_Early_Step_Semantics.Match)
with RelRel' PRel show ?case by blast
qed
qed
lemma mismatchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes PSimQ: "P ↝«Rel» Q"
and RelRel': "Rel ⊆ Rel'"
shows "[a≠b]P ↝«Rel'» [a≠b]Q"
proof(induct rule: simCases)
case(Bound c x Q')
have "x ♯ [a≠b]P" by fact
hence xFreshP: "(x::name) ♯ P" by simp
have "[a≠b]Q ⟼c<νx> ≺ Q'" by fact
thus ?case
proof(induct rule: mismatchCases)
case Mismatch
have aineqb: "a ≠ b" by fact
have "Q ⟼c<νx> ≺ Q'" by fact
with PSimQ xFreshP obtain P' where PTrans: "P ⟹c<νx> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans aineqb have "[a≠b]P ⟹c<νx> ≺ P'" by(rule Weak_Early_Step_Semantics.Mismatch)
moreover from P'RelQ' RelRel' have "(P', Q') ∈ Rel'" by blast
ultimately show ?case by blast
qed
next
case(Free α Q')
have "[a≠b]Q ⟼α ≺ Q'" by fact
thus ?case
proof(induct rule: mismatchCases)
case Mismatch
have "Q ⟼α ≺ Q'" by fact
with PSimQ obtain P' where PTrans: "P ⟹α ≺ P'" and PRel: "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans ‹a ≠ b› have "[a≠b]P ⟹α ≺ P'" by(rule Weak_Early_Step_Semantics.Mismatch)
with RelRel' PRel show ?case by blast
qed
qed
lemma sumPres:
fixes P :: pi
and Q :: pi
and R :: pi
assumes PSimQ: "P ↝«Rel» Q"
and RelRel': "Rel ⊆ Rel'"
and C: "Id ⊆ Rel'"
shows "P ⊕ R ↝«Rel'» Q ⊕ R"
proof(induct rule: simCases)
case(Bound a x Q')
have "x ♯ P ⊕ R" by fact
hence xFreshP: "(x::name) ♯ P" and xFreshR: "x ♯ R" by simp+
have "Q ⊕ R ⟼a<νx> ≺ Q'" by fact
thus ?case
proof(induct rule: sumCases)
case Sum1
have "Q ⟼a<νx> ≺ Q'" by fact
with xFreshP PSimQ obtain P' where PTrans: "P ⟹a<νx> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans have "P ⊕ R ⟹a<νx> ≺ P'" by(rule Weak_Early_Step_Semantics.Sum1)
moreover from P'RelQ' RelRel' have "(P', Q') ∈ Rel'" by blast
ultimately show ?case by blast
next
case Sum2
from ‹R ⟼a<νx> ≺ Q'› have "P ⊕ R ⟼a<νx> ≺ Q'" by(rule Early_Semantics.Sum2)
hence "P ⊕ R ⟹a<νx> ≺ Q'" by(rule Weak_Early_Step_Semantics.singleActionChain)
moreover from C have "(Q', Q') ∈ Rel'" by blast
ultimately show ?case by blast
qed
next
case(Free α Q')
have "Q ⊕ R ⟼α ≺ Q'" by fact
thus ?case
proof(induct rule: sumCases)
case Sum1
have "Q ⟼α ≺ Q'" by fact
with PSimQ obtain P' where PTrans: "P ⟹α ≺ P'" and PRel: "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans have "P ⊕ R ⟹α ≺ P'" by(rule Weak_Early_Step_Semantics.Sum1)
with RelRel' PRel show ?case by blast
next
case Sum2
from ‹R ⟼α ≺ Q'› have "P ⊕ R ⟼α ≺ Q'" by(rule Early_Semantics.Sum2)
hence "P ⊕ R ⟹α ≺ Q'" by(rule Weak_Early_Step_Semantics.singleActionChain)
moreover from C have "(Q', Q') ∈ Rel'" by blast
ultimately show ?case by blast
qed
qed
lemma parPres:
fixes P :: pi
and Q :: pi
and R :: pi
and T :: pi
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
and Rel'' :: "(pi × pi) set"
assumes PSimQ: "P ↝«Rel» Q"
and PRelQ: "(P, Q) ∈ Rel"
and Par: "⋀S T U. (S, T) ∈ Rel ⟹ (S ∥ U, T ∥ U) ∈ Rel'"
and Res: "⋀S T x. (S, T) ∈ Rel' ⟹ (<νx>S, <νx>T) ∈ Rel'"
shows "P ∥ R ↝«Rel'» Q ∥ R"
proof -
show ?thesis
proof(induct rule: simCases)
case(Bound a x Q')
have "x ♯ P ∥ R" by fact
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by simp+
have "Q ∥ R ⟼a<νx> ≺ Q'" by fact
thus ?case
proof(induct rule: parCasesB)
case(cPar1 Q')
have QTrans: "Q ⟼ a<νx> ≺ Q'" by fact
from xFreshP PSimQ QTrans obtain P' where PTrans:"P ⟹ a<νx> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans xFreshR have "P ∥ R ⟹ a<νx> ≺ (P' ∥ R)" by(rule Weak_Early_Step_Semantics.Par1B)
moreover from P'RelQ' have "(P' ∥ R, Q' ∥ R) ∈ Rel'" by(rule Par)
ultimately show ?case by blast
next
case(cPar2 R')
from ‹R ⟼ a<νx> ≺ R'› ‹x ♯ P› have "P ∥ R ⟼a<νx> ≺ (P ∥ R')"
by(rule Early_Semantics.Par2B)
hence "P ∥ R ⟹ a<νx> ≺ (P ∥ R')" by(rule Weak_Early_Step_Semantics.singleActionChain)
moreover from PRelQ have "(P ∥ R', Q ∥ R') ∈ Rel'" by(rule Par)
ultimately show ?case by blast
qed
next
case(Free α QR')
have "Q ∥ R ⟼ α ≺ QR'" by fact
thus ?case
proof(induct rule: parCasesF[of _ _ _ _ _ "(P, R)"])
case(cPar1 Q')
have "Q ⟼ α ≺ Q'" by fact
with PSimQ obtain P' where PTrans: "P ⟹ α ≺ P'" and PRel: "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans have Trans: "P ∥ R ⟹ α ≺ P' ∥ R" by(rule Weak_Early_Step_Semantics.Par1F)
moreover from PRel have "(P' ∥ R, Q' ∥ R) ∈ Rel'" by(blast intro: Par)
ultimately show ?case by blast
next
case(cPar2 R')
from ‹R ⟼α ≺ R'› have "P ∥ R ⟼α ≺ (P ∥ R')"
by(rule Early_Semantics.Par2F)
hence "P ∥ R ⟹α ≺ (P ∥ R')" by(rule Weak_Early_Step_Semantics.singleActionChain)
moreover from PRelQ have "(P ∥ R', Q ∥ R') ∈ Rel'" by(rule Par)
ultimately show ?case by blast
next
case(cComm1 Q' R' a b)
have QTrans: "Q ⟼ a<b> ≺ Q'" and RTrans: "R ⟼ a[b] ≺ R'" by fact+
from PSimQ QTrans obtain P' where PTrans: "P ⟹a<b> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from RTrans have "R ⟹a[b] ≺ R'" by(rule Weak_Early_Step_Semantics.singleActionChain)
with PTrans have "P ∥ R ⟹ τ ≺ P' ∥ R'" by(rule Weak_Early_Step_Semantics.Comm1)
moreover from P'RelQ' have "(P' ∥ R', Q' ∥ R') ∈ Rel'" by(rule Par)
ultimately show ?case by blast
next
case(cComm2 Q' R' a b)
have QTrans: "Q ⟼a[b] ≺ Q'" and RTrans: "R ⟼a<b> ≺ R'" by fact+
from PSimQ QTrans obtain P' where PTrans: "P ⟹a[b] ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from RTrans have "R ⟹a<b> ≺ R'" by(rule Weak_Early_Step_Semantics.singleActionChain)
with PTrans have "P ∥ R ⟹ τ ≺ P' ∥ R'" by(rule Weak_Early_Step_Semantics.Comm2)
moreover from P'RelQ' have "(P' ∥ R', Q' ∥ R') ∈ Rel'" by(rule Par)
ultimately show ?case by blast
next
case(cClose1 Q' R' a x)
have QTrans: "Q ⟼a<x> ≺ Q'" and RTrans: "R ⟼a<νx> ≺ R'" by fact+
have "x ♯ (P, R)" by fact
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by(simp add: fresh_prod)+
from PSimQ QTrans obtain P' where PTrans: "P ⟹a<x> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from RTrans have "R ⟹a<νx> ≺ R'" by(rule Weak_Early_Step_Semantics.singleActionChain)
with PTrans have Trans: "P ∥ R ⟹ τ ≺ <νx>(P' ∥ R')" using ‹x ♯ P›
by(rule Weak_Early_Step_Semantics.Close1)
moreover from P'RelQ' have "(<νx>(P' ∥ R'), <νx>(Q' ∥ R')) ∈ Rel'"
by(blast intro: Par Res)
ultimately show ?case by blast
next
case(cClose2 Q' R' a x)
have QTrans: "Q ⟼a<νx> ≺ Q'" and RTrans: "R ⟼a<x> ≺ R'" by fact+
have "x ♯ (P, R)" by fact
hence xFreshR: "x ♯ R" and xFreshP: "x ♯ P" by(simp add: fresh_prod)+
from PSimQ QTrans xFreshP obtain P' where PTrans: "P ⟹a<νx> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from RTrans have "R ⟹a<x> ≺ R'" by(rule Weak_Early_Step_Semantics.singleActionChain)
with PTrans have Trans: "P ∥ R ⟹τ ≺ <νx>(P' ∥ R')" using ‹x ♯ R›
by(rule Weak_Early_Step_Semantics.Close2)
moreover from P'RelQ' have "(<νx>(P' ∥ R'), <νx>(Q' ∥ R')) ∈ Rel'"
by(blast intro: Par Res)
ultimately show ?case by blast
qed
qed
qed
lemma resPres:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and x :: name
and Rel' :: "(pi × pi) set"
assumes PSimQ: "P ↝«Rel» Q"
and C1: "⋀R S x. (R, S) ∈ Rel ⟹ (<νx>R, <νx>S) ∈ Rel'"
and RelRel': "Rel ⊆ Rel'"
and EqvtRel: "eqvt Rel"
and EqvtRel': "eqvt Rel'"
shows "<νx>P ↝«Rel'» <νx>Q"
proof -
from EqvtRel' show ?thesis
proof(induct rule: simCasesCont[of _ "(P, x)"])
case(Bound a y Q')
have Trans: "<νx>Q ⟼a<νy> ≺ Q'" by fact
have "y ♯ (P, x)" by fact
hence yineqx: "y ≠ x" and yFreshP: "y ♯ P" by(simp add: fresh_prod)+
from Trans yineqx show ?case
proof(induct rule: resCasesB)
case(Open Q')
have QTrans: "Q ⟼a[x] ≺ Q'" and aineqx: "a ≠ x" by fact+
from PSimQ QTrans obtain P' where PTrans: "P ⟹a[x] ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans aineqx have "<νx>P ⟹a<νx> ≺ P'" by(rule Weak_Early_Step_Semantics.Open)
hence "<νx>P ⟹a<νy> ≺ ([(y, x)] ∙ P')" using ‹y ♯ P› ‹y ≠ x›
by(force simp add: weakTransitionAlpha abs_fresh name_swap)
moreover from EqvtRel P'RelQ' RelRel' have "([(y, x)] ∙ P', [(y, x)] ∙ Q') ∈ Rel'"
by(blast intro: eqvtRelI)
ultimately show ?case by blast
next
case(Res Q')
have QTrans: "Q ⟼a<νy> ≺ Q'" and xineqa: "x ≠ a" by fact+
from PSimQ yFreshP QTrans obtain P' where PTrans: "P ⟹a<νy> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans xineqa yineqx yFreshP have ResTrans: "<νx>P ⟹a<νy> ≺ (<νx>P')"
by(blast intro: Weak_Early_Step_Semantics.ResB)
moreover from P'RelQ' have "((<νx>P'), (<νx>Q')) ∈ Rel'"
by(rule C1)
ultimately show ?case by blast
qed
next
case(Free α Q')
have QTrans: "<νx>Q ⟼ α ≺ Q'" by fact
have "∃c::name. c ♯ (P, Q, Q', α)" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshQ: "c ♯ Q" and cFreshAlpha: "c ♯ α" and cFreshQ': "c ♯ Q'" and cFreshP: "c ♯ P"
by(force simp add: fresh_prod)
from cFreshP have "<νx>P = <νc>([(x, c)] ∙ P)" by(simp add: alphaRes)
moreover have "∃P'.<νc>([(x, c)] ∙ P) ⟹ α ≺ P' ∧ (P', Q') ∈ Rel'"
proof -
from QTrans cFreshQ have "<νc>([(x, c)] ∙ Q) ⟼α ≺ Q'" by(simp add: alphaRes)
moreover have "c ♯ α" by(rule cFreshAlpha)
moreover from PSimQ EqvtRel have "([(x, c)] ∙ P) ↝«Rel» ([(x, c)] ∙ Q)"
by(blast intro: eqvtI)
ultimately show ?thesis
apply(induct rule: resCasesF, auto simp add: residual.inject pi.inject name_abs_eq)
by(blast intro: Weak_Early_Step_Semantics.ResF C1 dest: simE)
qed
ultimately show ?case by force
qed
qed
lemma resChainI:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and lst :: "name list"
assumes eqvtRel: "eqvt Rel"
and Res: "⋀R S x. (R, S) ∈ Rel ⟹ (<νx>R, <νx>S) ∈ Rel"
and PRelQ: "P ↝«Rel» Q"
shows "(resChain lst) P ↝«Rel» (resChain lst) Q"
proof -
show ?thesis
proof(induct lst)
from PRelQ show "resChain [] P ↝«Rel» resChain [] Q" by simp
next
fix a lst
assume IH: "(resChain lst P) ↝«Rel» (resChain lst Q)"
moreover from Res have "⋀P Q a. (P, Q) ∈ Rel ⟹ (<νa>P, <νa>Q) ∈ Rel"
by simp
moreover have "Rel ⊆ Rel" by simp
ultimately have "<νa>(resChain lst P) ↝«Rel» <νa>(resChain lst Q)" using eqvtRel
by(rule_tac resPres)
thus "resChain (a # lst) P ↝«Rel» resChain (a # lst) Q"
by simp
qed
qed
lemma bangPres:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
assumes PRelQ: "(P, Q) ∈ Rel"
and Sim: "⋀R S. (R, S) ∈ Rel ⟹ R ↝«Rel'» S"
and C1: "Rel ⊆ Rel'"
and eqvtRel: "eqvt Rel'"
shows "!P ↝«bangRel Rel'» !Q"
proof -
let ?Sim = "λP Rs. (∀a x Q'. Rs = a<νx> ≺ Q' ⟶ x ♯ P ⟶ (∃P'. P ⟹a<νx> ≺ P' ∧ (P', Q') ∈ bangRel Rel')) ∧
(∀α Q'. Rs = α ≺ Q' ⟶ (∃P'. P ⟹α ≺ P' ∧ (P', Q') ∈ bangRel Rel'))"
from eqvtRel have EqvtBangRel: "eqvt(bangRel Rel')" by(rule eqvtBangRel)
from C1 have BRelRel': "⋀P Q. (P, Q) ∈ bangRel Rel ⟹ (P, Q) ∈ bangRel Rel'"
by(auto intro: bangRelSubset)
{
fix Pa Rs
assume "!Q ⟼ Rs" and "(Pa, !Q) ∈ bangRel Rel"
hence "?Sim Pa Rs" using PRelQ
proof(nominal_induct avoiding: Pa P rule: bangInduct)
case(Par1B a x Q' Pa P)
have QTrans: "Q ⟼ a<νx> ≺ Q'" by fact
have "(Pa, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ Pa" by fact+
thus "?Sim Pa (a<νx> ≺ (Q' ∥ !Q))"
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" by fact
have PBRQ: "(R, !Q) ∈ bangRel Rel" by fact
have "x ♯ P ∥ R" by fact
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by simp+
show ?case
proof(auto simp add: residual.inject alpha')
from PRelQ have "P ↝«Rel'» Q" by(rule Sim)
with QTrans xFreshP obtain P' where PTrans: "P ⟹a<νx> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel'"
by(blast dest: simE)
from PTrans xFreshR have "P ∥ R ⟹a<νx> ≺ (P' ∥ R)"
by(force intro: Weak_Early_Step_Semantics.Par1B)
moreover from P'RelQ' PBRQ BRelRel' have "(P' ∥ R, Q' ∥ !Q) ∈ bangRel Rel'" by(blast intro: Rel.BRPar)
ultimately show "∃P'. P ∥ R ⟹a<νx> ≺ P' ∧ (P', Q' ∥ !Q) ∈ bangRel Rel'" by blast
next
fix y
assume "(y::name) ♯ Q'" and "y ♯ P" and "y ♯ R" and "y ♯ Q"
from QTrans ‹y ♯ Q'› have "Q ⟼a<νy> ≺ ([(x, y)] ∙ Q')"
by(simp add: alphaBoundOutput)
moreover from PRelQ have "P ↝«Rel'» Q" by(rule Sim)
ultimately obtain P' where PTrans: "P ⟹a<νy> ≺ P'" and P'RelQ': "(P', [(x, y)] ∙ Q') ∈ Rel'"
using ‹y ♯ P›
by(blast dest: simE)
from PTrans ‹y ♯ R› have "P ∥ R ⟹a<νy> ≺ (P' ∥ R)" by(force intro: Weak_Early_Step_Semantics.Par1B)
moreover from P'RelQ' PBRQ BRelRel' have "(P' ∥ R, ([(x, y)] ∙ Q') ∥ !Q) ∈ bangRel Rel'" by(metis Rel.BRPar)
with ‹x ♯ Q› ‹y ♯ Q› have "(P' ∥ R, ([(y, x)] ∙ Q') ∥ !([(y, x)] ∙ Q)) ∈ bangRel Rel'"
by(simp add: name_fresh_fresh name_swap)
ultimately show "∃P'. P ∥ R ⟹a<νy> ≺ P' ∧ (P', ([(y, x)] ∙ Q') ∥ !([(y, x)] ∙ Q)) ∈ bangRel Rel'"
by blast
qed
qed
next
case(Par1F α Q' Pa P)
have QTrans: "Q ⟼α ≺ Q'" by fact
have "(Pa, Q ∥ !Q) ∈ bangRel Rel" by fact
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and BR: "(R, !Q) ∈ bangRel Rel" by fact+
show ?case
proof(auto simp add: residual.inject)
from PRelQ have "P ↝«Rel'» Q" by(rule Sim)
with QTrans obtain P' where PTrans: "P ⟹α ≺ P'" and RRel: "(P', Q') ∈ Rel'"
by(blast dest: simE)
from PTrans have "P ∥ R ⟹α ≺ P' ∥ R" by(rule Weak_Early_Step_Semantics.Par1F)
moreover from RRel BR BRelRel' have "(P' ∥ R, Q' ∥ !Q) ∈ bangRel Rel'" by(metis Rel.BRPar)
ultimately show "∃P'. P ∥ R ⟹α ≺ P' ∧ (P', Q' ∥ !Q) ∈ bangRel Rel'" by blast
qed
qed
next
case(Par2B a x Q' Pa P)
hence IH: "⋀Pa. (Pa, !Q) ∈ bangRel Rel ⟹ ?Sim Pa (a<νx> ≺ Q')" by simp
have "(Pa, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ Pa" by fact+
thus "?Sim Pa (a<νx> ≺ (Q ∥ Q'))"
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBRQ: "(R, !Q) ∈ bangRel Rel" by fact+
have "x ♯ P ∥ R" by fact
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by simp+
from EqvtBangRel show "?Sim (P ∥ R) (a<νx> ≺ (Q ∥ Q'))"
proof(auto simp add: residual.inject alpha')
from RBRQ have "?Sim R (a<νx> ≺ Q')" by(rule IH)
with xFreshR obtain R' where RTrans: "R ⟹a<νx> ≺ R'" and R'BRQ': "(R', Q') ∈ (bangRel Rel')"
by(metis simE)
from RTrans xFreshP have "P ∥ R ⟹a<νx> ≺ (P ∥ R')" by(auto intro: Weak_Early_Step_Semantics.Par2B)
moreover from PRelQ R'BRQ' C1 have "(P ∥ R', Q ∥ Q') ∈ (bangRel Rel')" by(blast dest: Rel.BRPar)
ultimately show "∃P'. P ∥ R ⟹a<νx> ≺ P' ∧ (P', Q ∥ Q') ∈ bangRel Rel'" by blast
next
fix y
assume "(y::name) ♯ Q" and "y ♯ Q'" and "y ♯ P" and "y ♯ R"
from RBRQ have "?Sim R (a<νx> ≺ Q')" by(rule IH)
with ‹y ♯ Q'› have "?Sim R (a<νy> ≺ ([(x, y)] ∙ Q'))" by(simp add: alphaBoundOutput)
with ‹y ♯ R› obtain R' where RTrans: "R ⟹a<νy> ≺ R'" and R'BRQ': "(R', ([(x, y)] ∙ Q')) ∈ (bangRel Rel')"
by(metis simE)
from RTrans ‹y ♯ P› have "P ∥ R ⟹a<νy> ≺ (P ∥ R')" by(auto intro: Weak_Early_Step_Semantics.Par2B)
moreover from PRelQ R'BRQ' C1 have "(P ∥ R', Q ∥ ([(x, y)] ∙ Q')) ∈ (bangRel Rel')" by(blast dest: Rel.BRPar)
with ‹y ♯ Q› ‹x ♯ Q› have "(P ∥ R', ([(y, x)] ∙ Q) ∥ ([(y, x)] ∙ Q')) ∈ (bangRel Rel')"
by(simp add: name_swap name_fresh_fresh)
ultimately show "∃P'. P ∥ R ⟹a<νy> ≺ P' ∧ (P', ([(y, x)] ∙ Q) ∥ ([(y, x)] ∙ Q')) ∈ bangRel Rel'" by blast
qed
qed
next
case(Par2F α Q' Pa P)
hence IH: "⋀Pa. (Pa, !Q) ∈ bangRel Rel ⟹ ?Sim Pa (α ≺ Q')" by simp
have "(Pa, Q ∥ !Q) ∈ bangRel Rel" by fact
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBRQ: "(R, !Q) ∈ bangRel Rel" by fact+
show ?case
proof(auto simp add: residual.inject)
from RBRQ IH have "∃R'. R ⟹α ≺ R' ∧ (R', Q') ∈ bangRel Rel'"
by(metis simE)
then obtain R' where RTrans: "R ⟹α ≺ R'" and R'RelQ': "(R', Q') ∈ bangRel Rel'"
by blast
from RTrans have "P ∥ R ⟹α ≺ P ∥ R'" by(rule Weak_Early_Step_Semantics.Par2F)
moreover from PRelQ R'RelQ' C1 have "(P ∥ R', Q ∥ Q') ∈ bangRel Rel'" by(blast dest: Rel.BRPar)
ultimately show " ∃P'. P ∥ R ⟹α ≺ P' ∧ (P', Q ∥ Q') ∈ bangRel Rel'" by blast
qed
qed
next
case(Comm1 a Q' b Q'' Pa P)
hence IH: "⋀Pa. (Pa, !Q) ∈ bangRel Rel ⟹ ?Sim Pa (a[b] ≺ Q'')" by simp
have QTrans: "Q ⟼a<b> ≺ Q'" by fact
have "(Pa, Q ∥ !Q) ∈ bangRel Rel" by fact
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBRQ: "(R, !Q) ∈ bangRel Rel" by fact+
show ?case
proof(auto simp add: residual.inject)
from PRelQ have "P ↝«Rel'» Q" by(rule Sim)
with QTrans obtain P' where PTrans: "P ⟹a<b> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel'"
by(blast dest: simE)
from IH RBRQ have RTrans: "∃R'. R ⟹a[b] ≺ R' ∧ (R', Q'') ∈ bangRel Rel'"
by(metis simE)
then obtain R' where RTrans: "R ⟹a[b] ≺ R'" and R'RelQ'': "(R', Q'') ∈ bangRel Rel'"
by blast
from PTrans RTrans have "P ∥ R ⟹τ ≺ P' ∥ R'" by(rule Weak_Early_Step_Semantics.Comm1)
moreover from P'RelQ' R'RelQ'' have "(P' ∥ R', Q' ∥ Q'') ∈ bangRel Rel'" by(rule Rel.BRPar)
ultimately show "∃P'. P ∥ R ⟹τ ≺ P' ∧ (P', Q' ∥ Q'') ∈ bangRel Rel'" by blast
qed
qed
next
case(Comm2 a b Q' Q'')
hence IH: "⋀Pa. (Pa, !Q) ∈ bangRel Rel ⟹ ?Sim Pa (a<b> ≺ Q'')" by simp
have QTrans: "Q ⟼ a[b] ≺ Q'" by fact
have "(Pa, Q ∥ !Q) ∈ bangRel Rel" by fact
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBRQ: "(R, !Q) ∈ bangRel Rel" by fact+
show ?case
proof(auto simp add: residual.inject)
from PRelQ have "P ↝«Rel'» Q" by(rule Sim)
with QTrans obtain P' where PTrans: "P ⟹a[b] ≺ P'" and P'RelQ': "(P', Q') ∈ Rel'"
by(blast dest: simE)
from IH RBRQ have RTrans: "∃R'. R ⟹a<b> ≺ R' ∧ (R', Q'') ∈ bangRel Rel'"
by(metis simE)
then obtain R' where RTrans: "R ⟹a<b> ≺ R'" and R'RelQ'': "(R', Q'') ∈ bangRel Rel'"
by blast
from PTrans RTrans have "P ∥ R ⟹τ ≺ P' ∥ R'" by(rule Weak_Early_Step_Semantics.Comm2)
moreover from P'RelQ' R'RelQ'' have "(P' ∥ R', Q' ∥ Q'') ∈ bangRel Rel'" by(rule Rel.BRPar)
ultimately show "∃P'. P ∥ R ⟹τ ≺ P' ∧ (P', Q' ∥ Q'') ∈ bangRel Rel'" by blast
qed
qed
next
case(Close1 a x Q' Q'' Pa P)
hence IH: "⋀Pa. (Pa, !Q) ∈ bangRel Rel ⟶ ?Sim Pa (a<νx> ≺ Q'')" by simp
have QTrans: "Q ⟼ a<x> ≺ Q'" by fact
have xFreshQ: "x ♯ Q" by fact
have "(Pa, Q ∥ !Q) ∈ bangRel Rel" by fact
moreover have xFreshPa: "x ♯ Pa" by fact
ultimately show ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBRQ: "(R, !Q) ∈ bangRel Rel" by fact+
have "x ♯ P ∥ R" by fact
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by simp+
show ?case
proof(auto simp add: residual.inject)
from PRelQ have "P ↝«Rel'» Q" by(rule Sim)
with QTrans xFreshP obtain P' where PTrans: "P ⟹a<x> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel'"
by(blast dest: simE)
from RBRQ xFreshR IH have "∃R'. R ⟹a<νx> ≺ R' ∧ (R', Q'') ∈ bangRel Rel'"
by(metis simE)
then obtain R' where RTrans: "R ⟹a<νx> ≺ R'" and R'RelQ'': "(R', Q'') ∈ bangRel Rel'"
by blast
from PTrans RTrans xFreshP have "P ∥ R ⟹τ ≺ <νx>(P' ∥ R')"
by(rule Weak_Early_Step_Semantics.Close1)
moreover from P'RelQ' R'RelQ'' have "(<νx>(P' ∥ R'), <νx>(Q' ∥ Q'')) ∈ bangRel Rel'"
by(force intro: Rel.BRPar BRRes)
ultimately show "∃P'. P ∥ R ⟹τ ≺ P' ∧ (P', <νx>(Q' ∥ Q'')) ∈ bangRel Rel'" by blast
qed
qed
next
case(Close2 a x Q' Q'' Pa P)
hence IH: "⋀Pa. (Pa, !Q) ∈ bangRel Rel ⟹ ?Sim Pa (a<x> ≺ Q'')" by simp
have QTrans: "Q ⟼ a<νx> ≺ Q'" by fact
have xFreshQ: "x ♯ Q" by fact
have "(Pa, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ Pa" by fact+
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBRQ: "(R, !Q) ∈ bangRel Rel" by fact+
have "x ♯ P ∥ R" by fact
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by simp+
show ?case
proof(auto simp add: residual.inject)
from PRelQ have "P ↝«Rel'» Q" by(rule Sim)
with QTrans xFreshP obtain P' where PTrans: "P ⟹a<νx> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel'"
by(blast dest: simE)
from RBRQ IH have "∃R'. R ⟹a<x> ≺ R' ∧ (R', Q'') ∈ bangRel Rel'"
by auto
then obtain R' where RTrans: "R ⟹a<x> ≺ R'" and R'RelQ'': "(R', Q'') ∈ bangRel Rel'"
by blast
from PTrans RTrans xFreshR have "P ∥ R ⟹τ ≺ <νx>(P' ∥ R')"
by(rule Weak_Early_Step_Semantics.Close2)
moreover from P'RelQ' R'RelQ'' have "(<νx>(P' ∥ R'), <νx>(Q' ∥ Q'')) ∈ bangRel Rel'"
by(force intro: Rel.BRPar BRRes)
ultimately show "∃P'. P ∥ R ⟹τ ≺ P' ∧ (P', <νx>(Q' ∥ Q'')) ∈ bangRel Rel'" by blast
qed
qed
next
case(Bang Rs Pa P)
hence IH: "⋀Pa. (Pa, Q ∥ !Q) ∈ bangRel Rel ⟹ ?Sim Pa Rs" by simp
have "(Pa, !Q) ∈ bangRel Rel" by fact
thus ?case
proof(induct rule: BRBangCases)
case(BRBang P)
have PRelQ: "(P, Q) ∈ Rel" by fact
hence "(!P, !Q) ∈ bangRel Rel" by(rule Rel.BRBang)
with PRelQ have "(P ∥ !P, Q ∥ !Q) ∈ bangRel Rel" by(rule BRPar)
with IH have "?Sim (P ∥ !P) Rs" by simp
thus ?case by(force intro: Weak_Early_Step_Semantics.Bang)
qed
qed
}
moreover from PRelQ have "(!P, !Q) ∈ bangRel Rel" by(rule BRBang)
ultimately show ?thesis by(auto simp add: weakStepSimulation_def)
qed
end
Theory Weak_Early_Sim_Pres
theory Weak_Early_Sim_Pres
imports Weak_Early_Sim
begin
lemma tauPres:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes PRelQ: "(P, Q) ∈ Rel"
shows "τ.(P) ↝<Rel> τ.(Q)"
proof(induct rule: simCases)
case(Bound Q' a x)
have "τ.(Q) ⟼a<νx> ≺ Q'" by fact
hence False by(induct rule: tauCases', auto)
thus ?case by simp
next
case(Free Q' α)
have "τ.(Q) ⟼(α ≺ Q')" by fact
thus ?case
proof(induct rule: tauCases', auto simp only: pi.inject residual.inject)
have "τ.(P) ⟹⇧^ τ ≺ P" by(rule Tau)
with PRelQ show "∃P'. τ.(P) ⟹⇧^τ ≺ P' ∧ (P', Q) ∈ Rel" by blast
qed
qed
lemma inputPres:
fixes P :: pi
and x :: name
and Q :: pi
and a :: name
and Rel :: "(pi × pi) set"
assumes PRelQ: "∀y. (P[x::=y], Q[x::=y]) ∈ Rel"
and Eqvt: "eqvt Rel"
shows "a<x>.P ↝<Rel> a<x>.Q"
using Eqvt
proof(induct rule: simCasesCont[where C="(x, a, P, Q)"])
case(Bound b y Q')
from ‹y ♯ (x, a, P, Q)› have "y ≠ x" "y ≠ a" "y ♯ P" "y ♯ Q" by simp+
from ‹a<x>.Q ⟼b<νy> ≺ Q'› ‹y ≠ a› ‹y ≠ x› ‹y ♯ Q› show ?case
by(erule_tac inputCases') auto
next
case(Free α Q')
from ‹a<x>.Q ⟼ α ≺ Q'›
show ?case
proof(induct rule: inputCases)
case(cInput u)
have "a<x>.P ⟹⇧^(a<u>) ≺ P[x::=u]"
by(rule Input)
moreover from PRelQ have "(P[x::=u], Q[x::=u]) ∈ Rel" by auto
ultimately show ?case by blast
qed
qed
lemma outputPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
and Rel :: "(pi × pi) set"
assumes PRelQ: "(P, Q) ∈ Rel"
shows "a{b}.P ↝<Rel> a{b}.Q"
proof(induct rule: simCases)
case(Bound Q' c x)
have "a{b}.Q ⟼c<νx> ≺ Q'" by fact
hence False by(induct rule: outputCases', auto)
thus ?case by simp
next
case(Free Q' α)
have "a{b}.Q ⟼α ≺ Q'" by fact
thus "∃P'. a{b}.P ⟹⇧^ α ≺ P' ∧ (P', Q') ∈ Rel"
proof(induct rule: outputCases', auto simp add: pi.inject residual.inject)
have "a{b}.P ⟹⇧^ a[b] ≺ P" by(rule Output)
with PRelQ show "∃P'. a{b}.P ⟹⇧^ a[b] ≺ P' ∧ (P', Q) ∈ Rel" by blast
qed
qed
lemma matchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes PSimQ: "P ↝<Rel> Q"
and RelRel': "Rel ⊆ Rel'"
and RelStay: "⋀R S c. (R, S) ∈ Rel ⟹ ([c⌢c]R, S) ∈ Rel"
shows "[a⌢b]P ↝<Rel'> [a⌢b]Q"
proof(induct rule: simCases)
case(Bound Q' c x)
have "x ♯ [a⌢b]P" by fact
hence xFreshP: "(x::name) ♯ P" by simp
have "[a⌢b]Q ⟼c<νx> ≺ Q'" by fact
thus ?case
proof(induct rule: matchCases)
case Match
have "Q ⟼c<νx> ≺ Q'" by fact
with PSimQ xFreshP obtain P' where PTrans: "P ⟹c<νx> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans have "[a⌢a]P ⟹c<νx> ≺ P'" by(rule Weak_Early_Step_Semantics.Match)
moreover from P'RelQ' RelRel' have "(P', Q') ∈ Rel'" by blast
ultimately show ?case by blast
qed
next
case(Free Q' α)
have "[a⌢b]Q ⟼α ≺ Q'" by fact
thus ?case
proof(induct rule: matchCases)
case Match
have "Q ⟼ α ≺ Q'" by fact
with PSimQ obtain P' where "P ⟹⇧^α ≺ P'" and "(P', Q') ∈ Rel"
by(blast dest: simE)
thus ?case
proof(induct rule: transitionCases)
case Step
have "P ⟹α ≺ P'" by fact
hence "[a⌢a]P ⟹α ≺ P'" by(rule Weak_Early_Step_Semantics.Match)
with RelRel' ‹(P', Q') ∈ Rel› show ?case by(force simp add: weakFreeTransition_def)
next
case Stay
have "[a⌢a]P ⟹⇧^τ ≺ [a⌢a]P" by(simp add: weakFreeTransition_def)
moreover from ‹(P, Q') ∈ Rel› have "([a⌢a]P, Q') ∈ Rel" by(blast intro: RelStay)
ultimately show ?case using RelRel' by blast
qed
qed
qed
lemma mismatchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes PSimQ: "P ↝<Rel> Q"
and RelRel': "Rel ⊆ Rel'"
and RelStay: "⋀R S c d. ⟦(R, S) ∈ Rel; c ≠ d⟧ ⟹ ([c≠d]R, S) ∈ Rel"
shows "[a≠b]P ↝<Rel'> [a≠b]Q"
proof(induct rule: simCases)
case(Bound Q' c x)
have "x ♯ [a≠b]P" by fact
hence xFreshP: "(x::name) ♯ P" by simp
have "[a≠b]Q ⟼c<νx> ≺ Q'" by fact
thus ?case
proof(induct rule: mismatchCases)
case Mismatch
have aineqb: "a ≠ b" by fact
have "Q ⟼c<νx> ≺ Q'" by fact
with PSimQ xFreshP obtain P' where PTrans: "P ⟹c<νx> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans aineqb have "[a≠b]P ⟹c<νx> ≺ P'" by(rule Weak_Early_Step_Semantics.Mismatch)
moreover from P'RelQ' RelRel' have "(P', Q') ∈ Rel'" by blast
ultimately show ?case by blast
qed
next
case(Free Q' α)
have "[a≠b]Q ⟼α ≺ Q'" by fact
thus ?case
proof(induct rule: mismatchCases)
case Mismatch
have aineqb: "a ≠ b" by fact
have "Q ⟼ α ≺ Q'" by fact
with PSimQ obtain P' where "P ⟹⇧^α ≺ P'" and "(P', Q') ∈ Rel"
by(blast dest: simE)
thus ?case
proof(induct rule: transitionCases)
case Step
have "P ⟹α ≺ P'" by fact
hence "[a≠b]P ⟹α ≺ P'" using aineqb by(rule Weak_Early_Step_Semantics.Mismatch)
with RelRel' ‹(P', Q') ∈ Rel› show ?case by(force simp add: weakFreeTransition_def)
next
case Stay
have "[a≠b]P ⟹⇧^τ ≺ [a≠b]P" by(simp add: weakFreeTransition_def)
moreover from ‹(P, Q') ∈ Rel› aineqb have "([a≠b]P, Q') ∈ Rel" by(blast intro: RelStay)
ultimately show ?case using RelRel' by blast
qed
qed
qed
lemma parCompose:
fixes P :: pi
and Q :: pi
and R :: pi
and S :: pi
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
and Rel'' :: "(pi × pi) set"
assumes PSimQ: "P ↝<Rel> Q"
and RSimT: "R ↝<Rel'> S"
and PRelQ: "(P, Q) ∈ Rel"
and RRel'T: "(R, S) ∈ Rel'"
and Par: "⋀P' Q' R' S'. ⟦(P', Q') ∈ Rel; (R', S') ∈ Rel'⟧ ⟹ (P' ∥ R', Q' ∥ S') ∈ Rel''"
and Res: "⋀T U x. (T, U) ∈ Rel'' ⟹ (<νx>T, <νx>U) ∈ Rel''"
shows "P ∥ R ↝<Rel''> Q ∥ S"
proof -
show ?thesis
proof(induct rule: simCases)
case(Bound Q' a x)
have "x ♯ P ∥ R" by fact
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by simp+
have "Q ∥ S ⟼a<νx> ≺ Q'" by fact
thus ?case
proof(induct rule: parCasesB)
case(cPar1 Q')
have QTrans: "Q ⟼ a<νx> ≺ Q'" and xFreshT: "x ♯ S" by fact+
from xFreshP PSimQ QTrans obtain P' where PTrans:"P ⟹a<νx> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans xFreshR have "P ∥ R ⟹a<νx> ≺ (P' ∥ R)" by(rule Weak_Early_Step_Semantics.Par1B)
moreover from P'RelQ' RRel'T have "(P' ∥ R, Q' ∥ S) ∈ Rel''" by(rule Par)
ultimately show ?case by blast
next
case(cPar2 S')
have STrans: "S ⟼ a<νx> ≺ S'" and xFreshQ: "x ♯ Q" by fact+
from xFreshR RSimT STrans obtain R' where RTrans:"R ⟹a<νx> ≺ R'"
and R'Rel'T': "(R', S') ∈ Rel'"
by(blast dest: simE)
from RTrans xFreshP xFreshR have ParTrans: "P ∥ R ⟹a<νx> ≺ (P ∥ R')"
by(blast intro: Weak_Early_Step_Semantics.Par2B)
moreover from PRelQ R'Rel'T' have "(P ∥ R', Q ∥ S') ∈ Rel''" by(rule Par)
ultimately show ?case by blast
qed
next
case(Free QT' α)
have "Q ∥ S ⟼ α ≺ QT'" by fact
thus ?case
proof(induct rule: parCasesF[of _ _ _ _ _ "(P, R)"])
case(cPar1 Q')
have "Q ⟼ α ≺ Q'" by fact
with PSimQ obtain P' where PTrans: "P ⟹⇧^ α ≺ P'" and PRel: "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans have Trans: "P ∥ R ⟹⇧^ α ≺ P' ∥ R" by(rule Weak_Early_Semantics.Par1F)
moreover from PRel RRel'T have "(P' ∥ R, Q' ∥ S) ∈ Rel''" by(blast intro: Par)
ultimately show ?case by blast
next
case(cPar2 S')
have "S ⟼ α ≺ S'" by fact
with RSimT obtain R' where RTrans: "R ⟹⇧^ α ≺ R'" and RRel: "(R', S') ∈ Rel'"
by(blast dest: simE)
from RTrans have Trans: "P ∥ R ⟹⇧^ α ≺ P ∥ R'" by(rule Weak_Early_Semantics.Par2F)
moreover from PRelQ RRel have "(P ∥ R', Q ∥ S') ∈ Rel''" by(blast intro: Par)
ultimately show ?case by blast
next
case(cComm1 Q' S' a b)
have QTrans: "Q ⟼ a<b> ≺ Q'" and STrans: "S ⟼ a[b] ≺ S'" by fact+
from PSimQ QTrans obtain P' where PTrans: "P ⟹a<b> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(fastforce dest: simE simp add: weakFreeTransition_def)
from RSimT STrans obtain R' where RTrans: "R ⟹a[b] ≺ R'"
and RRel: "(R', S') ∈ Rel'"
by(fastforce dest: simE simp add: weakFreeTransition_def)
from PTrans RTrans have "P ∥ R ⟹τ ≺ P' ∥ R'" by(rule Weak_Early_Step_Semantics.Comm1)
hence "P ∥ R ⟹⇧^τ ≺ P' ∥ R'"
by(auto simp add: trancl_into_rtrancl dest: Weak_Early_Step_Semantics.tauTransitionChain)
moreover from P'RelQ' RRel have "(P' ∥ R', Q' ∥ S') ∈ Rel''" by(rule Par)
ultimately show ?case by blast
next
case(cComm2 Q' S' a b)
have QTrans: "Q ⟼a[b] ≺ Q'" and STrans: "S ⟼a<b> ≺ S'" by fact+
from PSimQ QTrans obtain P' where PTrans: "P ⟹a[b] ≺ P'"
and PRel: "(P', Q') ∈ Rel"
by(fastforce dest: simE simp add: weakFreeTransition_def)
from RSimT STrans obtain R' where RTrans: "R ⟹a<b> ≺ R'"
and R'Rel'T': "(R', S') ∈ Rel'"
by(fastforce dest: simE simp add: weakFreeTransition_def)
from PTrans RTrans have "P ∥ R ⟹τ ≺ P' ∥ R'" by(rule Weak_Early_Step_Semantics.Comm2)
hence "P ∥ R ⟹⇧^τ ≺ P' ∥ R'"
by(auto simp add: trancl_into_rtrancl dest: Weak_Early_Step_Semantics.tauTransitionChain)
moreover from PRel R'Rel'T' have "(P' ∥ R', Q' ∥ S') ∈ Rel''" by(rule Par)
ultimately show ?case by blast
next
case(cClose1 Q' S' a x)
have QTrans: "Q ⟼a<x> ≺ Q'" and STrans: "S ⟼a<νx> ≺ S'" by fact+
have "x ♯ (P, R)" by fact
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by(simp add: fresh_prod)+
from PSimQ QTrans obtain P' where PTrans: "P ⟹a<x> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(fastforce dest: simE simp add: weakFreeTransition_def)
from RSimT STrans xFreshR obtain R' where RTrans: "R ⟹a<νx> ≺ R'"
and R'Rel'T': "(R', S') ∈ Rel'"
by(blast dest: simE)
from PTrans RTrans xFreshP have Trans: "P ∥ R ⟹τ ≺ <νx>(P' ∥ R')"
by(rule Weak_Early_Step_Semantics.Close1)
hence "P ∥ R ⟹⇧^τ ≺ <νx>(P' ∥ R')"
by(auto simp add: trancl_into_rtrancl dest: Weak_Early_Step_Semantics.tauTransitionChain)
moreover from P'RelQ' R'Rel'T' have "(<νx>(P' ∥ R'), <νx>(Q' ∥ S')) ∈ Rel''"
by(blast intro: Par Res)
ultimately show ?case by blast
next
case(cClose2 Q' S' a x)
have QTrans: "Q ⟼a<νx> ≺ Q'" and STrans: "S ⟼a<x> ≺ S'" by fact+
have "x ♯ (P, R)" by fact
hence xFreshR: "x ♯ R" and xFreshP: "x ♯ P" by(simp add: fresh_prod)+
from PSimQ QTrans xFreshP obtain P' where PTrans: "P ⟹a<νx> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from RSimT STrans obtain R' where RTrans: "R ⟹a<x> ≺ R'"
and R'Rel'T': "(R', S') ∈ Rel'"
by(fastforce dest: simE simp add: weakFreeTransition_def)
from PTrans RTrans xFreshR have Trans: "P ∥ R ⟹τ ≺ <νx>(P' ∥ R')"
by(rule Weak_Early_Step_Semantics.Close2)
hence "P ∥ R ⟹⇧^τ ≺ <νx>(P' ∥ R')"
by(auto simp add: trancl_into_rtrancl dest: Weak_Early_Step_Semantics.tauTransitionChain)
moreover from P'RelQ' R'Rel'T' have "(<νx>(P' ∥ R'), <νx>(Q' ∥ S')) ∈ Rel''"
by(blast intro: Par Res)
ultimately show ?case by blast
qed
qed
qed
lemma parPres:
fixes P :: pi
and Q :: pi
and R :: pi
and a :: name
and Rel :: "(pi × pi) set"
and Rel' :: "(pi × pi) set"
assumes PSimQ: "P ↝<Rel> Q"
and PRelQ: "(P, Q) ∈ Rel"
and Par: "⋀S T U. (S, T) ∈ Rel ⟹ (S ∥ U, T ∥ U) ∈ Rel'"
and Res: "⋀S T x. (S, T) ∈ Rel' ⟹ (<νx>S, <νx>T) ∈ Rel'"
shows "P ∥ R ↝<Rel'> Q ∥ R"
proof -
note PSimQ
moreover have RSimR: "R ↝<Id> R" by(auto intro: reflexive)
moreover note PRelQ moreover have "(R, R) ∈ Id" by auto
moreover from Par have "⋀P Q R T. ⟦(P, Q) ∈ Rel; (R, T) ∈ Id⟧ ⟹ (P ∥ R, Q ∥ T) ∈ Rel'"
by auto
ultimately show ?thesis using Res by(rule parCompose)
qed
lemma resPres:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and x :: name
and Rel' :: "(pi × pi) set"
assumes PSimQ: "P ↝<Rel> Q"
and ResRel: "⋀R S y. (R, S) ∈ Rel ⟹ (<νy>R, <νy>S) ∈ Rel'"
and RelRel': "Rel ⊆ Rel'"
and EqvtRel: "eqvt Rel"
and EqvtRel': "eqvt Rel'"
shows "<νx>P ↝<Rel'> <νx>Q"
proof -
from EqvtRel' show ?thesis
proof(induct rule: simCasesCont[where C="(P, x)"])
case(Bound a y Q')
have Trans: "<νx>Q ⟼a<νy> ≺ Q'" by fact
have "y ♯ (P, x)" by fact
hence yineqx: "y ≠ x" and yFreshP: "y ♯ P" by(simp add: fresh_prod)+
from Trans yineqx show ?case
proof(induct rule: resCasesB)
case(Open Q')
have QTrans: "Q ⟼a[x] ≺ Q'" and aineqx: "a ≠ x" by fact+
from PSimQ QTrans obtain P' where PTrans: "P ⟹⇧^a[x] ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans aineqx have "<νx>P ⟹a<νx> ≺ P'"
by(force intro: Weak_Early_Step_Semantics.Open simp add: weakFreeTransition_def)
with ‹y ♯ P› ‹y ≠ x› have "<νx>P ⟹a<νy> ≺ ([(y, x)] ∙ P')"
by(force intro: weakTransitionAlpha simp add: abs_fresh name_swap)
moreover from EqvtRel P'RelQ' RelRel' have "([(y, x)] ∙ P', [(y, x)] ∙ Q') ∈ Rel'"
by(blast intro: eqvtRelI)
ultimately show ?case by blast
next
case(Res Q')
have QTrans: "Q ⟼a<νy> ≺ Q'" and xineqa: "x ≠ a" by fact+
from PSimQ yFreshP QTrans obtain P' where PTrans: "P ⟹a<νy> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans xineqa yineqx yFreshP have ResTrans: "<νx>P ⟹a<νy> ≺ (<νx>P')"
by(blast intro: Weak_Early_Step_Semantics.ResB)
moreover from P'RelQ' have "((<νx>P'), (<νx>Q')) ∈ Rel'"
by(rule ResRel)
ultimately show ?case by blast
qed
next
case(Free α Q')
have QTrans: "<νx>Q ⟼ α ≺ Q'" by fact
have "∃c::name. c ♯ (P, Q, Q', α)" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshQ: "c ♯ Q" and cFreshAlpha: "c ♯ α" and cFreshQ': "c ♯ Q'" and cFreshP: "c ♯ P"
by(force simp add: fresh_prod)
from cFreshP have "<νx>P = <νc>([(x, c)] ∙ P)" by(simp add: alphaRes)
moreover have "∃P'.<νc>([(x, c)] ∙ P) ⟹⇧^ α ≺ P' ∧ (P', Q') ∈ Rel'"
proof -
from QTrans cFreshQ have "<νc>([(x, c)] ∙ Q) ⟼α ≺ Q'" by(simp add: alphaRes)
moreover have "c ♯ α" by(rule cFreshAlpha)
moreover from PSimQ EqvtRel have "([(x, c)] ∙ P) ↝<Rel> ([(x, c)] ∙ Q)"
by(blast intro: eqvtI)
ultimately show ?thesis
apply(induct rule: resCasesF, auto simp add: residual.inject pi.inject name_abs_eq)
by(blast intro: ResF ResRel dest: simE)
qed
ultimately show ?case by force
qed
qed
lemma resChainI:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and lst :: "name list"
assumes eqvtRel: "eqvt Rel"
and Res: "⋀R S y. (R, S) ∈ Rel ⟹ (<νy>R, <νy>S) ∈ Rel"
and PRelQ: "P ↝<Rel> Q"
shows "(resChain lst) P ↝<Rel> (resChain lst) Q"
proof -
show ?thesis
proof(induct lst)
from PRelQ show "resChain [] P ↝<Rel> resChain [] Q" by simp
next
fix a lst
assume IH: "(resChain lst P) ↝<Rel> (resChain lst Q)"
moreover from Res have "⋀P Q a. (P, Q) ∈ Rel ⟹ (<νa>P, <νa>Q) ∈ Rel"
by simp
moreover have "Rel ⊆ Rel" by simp
ultimately have "<νa>(resChain lst P) ↝<Rel> <νa>(resChain lst Q)" using eqvtRel
by(rule_tac resPres)
thus "resChain (a # lst) P ↝<Rel> resChain (a # lst) Q"
by simp
qed
qed
lemma bangPres:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
assumes PRelQ: "(P, Q) ∈ Rel"
and Sim: "⋀R S. (R, S) ∈ Rel ⟹ R ↝<Rel> S"
and ParComp: "⋀R S T U. ⟦(R, S) ∈ Rel; (T, U) ∈ Rel'⟧ ⟹ (R ∥ T, S ∥ U) ∈ Rel'"
and Res: "⋀R S x. (R, S) ∈ Rel' ⟹ (<νx>R, <νx>S) ∈ Rel'"
and RelStay: "⋀R S. (R ∥ !R, S) ∈ Rel' ⟹ (!R, S) ∈ Rel'"
and BangRelRel': "(bangRel Rel) ⊆ Rel'"
and eqvtRel': "eqvt Rel'"
shows "!P ↝<Rel'> !Q"
proof -
let ?Sim = "λP Rs. (∀a x Q'. Rs = a<νx> ≺ Q' ⟶ x ♯ P ⟶ (∃P'. P ⟹a<νx> ≺ P' ∧ (P', Q') ∈ Rel')) ∧
(∀α Q'. Rs = α ≺ Q' ⟶ (∃P'. P ⟹⇧^α ≺ P' ∧ (P', Q') ∈ Rel'))"
{
fix Rs P
assume "!Q ⟼ Rs" and "(P, !Q) ∈ bangRel Rel"
hence "?Sim P Rs" using PRelQ
proof(nominal_induct avoiding: P rule: bangInduct)
case(Par1B a x Q')
have QTrans: "Q ⟼a<νx> ≺ Q'" and xFreshQ: "x ♯ Q" by fact+
have "(P, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ P" by fact+
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBangRelT: "(R, !Q) ∈ bangRel Rel" by fact+
have "x ♯ P ∥ R" by fact
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by simp+
from PRelQ have PSimQ: "P ↝<Rel> Q" by(rule Sim)
from ‹x ♯ P› ‹x ♯ Q› show ?case
proof(auto simp add: residual.inject alpha' name_fresh_fresh)
from PSimQ QTrans xFreshP obtain P' where PTrans: "P ⟹a<νx> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans xFreshR have "P ∥ R ⟹a<νx>≺ (P' ∥ R)"
by(rule Weak_Early_Step_Semantics.Par1B)
moreover from P'RelQ' RBangRelT BangRelRel' have "(P' ∥ R, Q' ∥ !Q) ∈ Rel'"
by(blast intro: Rel.BRPar)
ultimately show "∃P'. P ∥ R ⟹a<νx> ≺ P' ∧ (P', Q' ∥ !Q) ∈ Rel'" by blast
next
fix y
assume "(y::name) ♯ Q'" and "y ♯ P" and "y ♯ R"
from QTrans ‹y ♯ Q'› have "Q ⟼a<νy> ≺ ([(x, y)] ∙ Q')" by(simp add: alphaBoundOutput)
with PSimQ ‹y ♯ P› obtain P' where PTrans: "P ⟹a<νy> ≺ P'"
and P'RelQ': "(P', [(x, y)] ∙ Q') ∈ Rel"
by(blast dest: simE)
from PTrans ‹y ♯ R› have "P ∥ R ⟹a<νy>≺ (P' ∥ R)" by(rule Weak_Early_Step_Semantics.Par1B)
moreover from P'RelQ' RBangRelT BangRelRel' have "(P' ∥ R, ([(y, x)] ∙ Q') ∥ !Q) ∈ Rel'"
by(fastforce intro: Rel.BRPar simp add: name_swap)
ultimately show "∃P'. P ∥ R ⟹a<νy> ≺ P' ∧ (P', ([(y, x)] ∙ Q') ∥ !Q) ∈ Rel'" by blast
qed
qed
next
case(Par1F α Q' P)
have QTrans: "Q ⟼α ≺ Q'" by fact
have "(P, Q ∥ !Q) ∈ bangRel Rel" by fact
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact+
show ?case
proof(auto simp add: residual.inject)
from PRelQ have "P ↝<Rel> Q" by(rule Sim)
with QTrans obtain P' where PTrans: "P ⟹⇧^α ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from PTrans have "P ∥ R ⟹⇧^α ≺ P' ∥ R" by(rule Weak_Early_Semantics.Par1F)
moreover from P'RelQ' RBangRelQ have "(P' ∥ R, Q' ∥ !Q) ∈ bangRel Rel"
by(rule Rel.BRPar)
ultimately show "∃P'. P ∥ R ⟹⇧^α ≺ P' ∧ (P', Q' ∥ !Q) ∈ Rel'" using BangRelRel' by blast
qed
qed
next
case(Par2B a x Q' P)
hence IH: "⋀P. (P, !Q) ∈ bangRel Rel ⟹ ?Sim P (a<νx> ≺ Q')" by simp
have xFreshQ: "x ♯ Q" by fact
have "(P, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ P" by fact+
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact+
have "x ♯ P ∥ R" by fact
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by simp+
show ?case using ‹x ♯ Q›
proof(auto simp add: residual.inject alpha' name_fresh_fresh)
from IH RBangRelQ have "?Sim R (a<νx> ≺ Q')" by blast
with xFreshR obtain R' where RTrans: "R ⟹a<νx> ≺ R'" and R'BangRelQ': "(R', Q') ∈ Rel'"
by(blast dest: simE)
from RTrans xFreshP have "P ∥ R ⟹a<νx> ≺ (P ∥ R')"
by(auto intro: Weak_Early_Step_Semantics.Par2B)
moreover from PRelQ R'BangRelQ' have "(P ∥ R', Q ∥ Q') ∈ Rel'"
by(rule ParComp)
ultimately show "∃P'. P ∥ R ⟹a<νx> ≺ P' ∧ (P', Q ∥ Q') ∈ Rel'" by blast
next
fix y
assume "(y::name) ♯ Q'" and "y ♯ R" and "y ♯ P"
from IH RBangRelQ have "?Sim R (a<νx> ≺ Q')" by blast
with ‹y ♯ Q'› have "?Sim R (a<νy> ≺ ([(x, y)] ∙ Q'))" by(simp add: alphaBoundOutput)
with ‹y ♯ R›obtain R' where RTrans: "R ⟹a<νy> ≺ R'" and R'BangRelQ': "(R', [(x, y)] ∙ Q') ∈ Rel'"
by(blast dest: simE)
from RTrans ‹y ♯ P› have "P ∥ R ⟹a<νy> ≺ (P ∥ R')"
by(auto intro: Weak_Early_Step_Semantics.Par2B)
moreover from PRelQ R'BangRelQ' have "(P ∥ R', Q ∥ ([(y, x)] ∙ Q')) ∈ Rel'"
by(fastforce intro: ParComp simp add: name_swap)
ultimately show "∃P'. P ∥ R ⟹a<νy> ≺ P' ∧ (P', Q ∥ ([(y, x)] ∙ Q')) ∈ Rel'" by blast
qed
qed
next
case(Par2F α Q' P)
hence IH: "⋀P. (P, !Q) ∈ bangRel Rel ⟹ ?Sim P (α ≺ Q')" by simp
have "(P, Q ∥ !Q) ∈ bangRel Rel" by fact
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact+
show ?case
proof(auto simp add: residual.inject)
from RBangRelQ have "?Sim R (α ≺ Q')" by(rule IH)
then obtain R' where RTrans: "R ⟹⇧^α ≺ R'" and R'RelQ': "(R', Q') ∈ Rel'"
by(blast dest: simE)
from RTrans have "P ∥ R ⟹⇧^α ≺ P ∥ R'" by(rule Weak_Early_Semantics.Par2F)
moreover from PRelQ R'RelQ' have "(P ∥ R', Q ∥ Q') ∈ Rel'" by(rule ParComp)
ultimately show "∃P'. P ∥ R ⟹⇧^α ≺ P' ∧ (P', Q ∥ Q') ∈ Rel'" by blast
qed
qed
next
case(Comm1 a Q' b Q'' P)
hence IH: "⋀P. (P, !Q) ∈ bangRel Rel ⟹ ?Sim P (a[b] ≺ Q'')" by simp
have QTrans: "Q ⟼ a<b> ≺ Q'" by fact
have "(P, Q ∥ !Q) ∈ bangRel Rel" by fact
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact+
show ?case
proof(auto simp add: residual.inject)
from PRelQ have "P ↝<Rel> Q" by(rule Sim)
with QTrans obtain P' where PTrans: "P ⟹a<b> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(fastforce dest: simE simp add: weakFreeTransition_def)
from RBangRelQ have "?Sim R (a[b] ≺ Q'')" by(rule IH)
then obtain R' where RTrans: "R ⟹a[b] ≺ R'"
and R'RelQ'': "(R', Q'') ∈ Rel'"
by(fastforce dest: simE simp add: weakFreeTransition_def)
from PTrans RTrans have "P ∥ R ⟹τ ≺ (P' ∥ R')"
by(rule Weak_Early_Step_Semantics.Comm1)
hence "P ∥ R ⟹⇩τ P' ∥ R'"
by(auto simp add: trancl_into_rtrancl dest: Weak_Early_Step_Semantics.tauTransitionChain)
moreover from P'RelQ' R'RelQ'' have "(P' ∥ R', Q' ∥ Q'') ∈ Rel'"
by(rule ParComp)
ultimately show "∃P'. (P ∥ R, P') ∈ {(P, P'). P ⟼ τ ≺ P'}⇧* ∧ (P', Q' ∥ Q'') ∈ Rel'"
by auto
qed
qed
next
case(Comm2 a b Q' Q'' P)
hence IH: "⋀P. (P, !Q) ∈ bangRel Rel ⟹ ?Sim P (a<b> ≺ Q'')" by simp
have QTrans: "Q ⟼a[b] ≺ Q'" by fact
have "(P, Q ∥ !Q) ∈ bangRel Rel" by fact
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact+
show ?case
proof(auto simp add: residual.inject)
from PRelQ have "P ↝<Rel> Q" by(rule Sim)
with QTrans obtain P' where PTrans: "P ⟹a[b] ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(fastforce dest: simE simp add: weakFreeTransition_def)
from RBangRelQ have "?Sim R (a<b> ≺ Q'')" by(rule IH)
then obtain R' where RTrans: "R ⟹a<b> ≺ R'" and R'BangRelQ'': "(R', Q'') ∈ Rel'"
by(fastforce dest: simE simp add: weakFreeTransition_def)
from PTrans RTrans have "P ∥ R ⟹τ ≺ (P' ∥ R')"
by(rule Weak_Early_Step_Semantics.Comm2)
hence "P ∥ R ⟹⇩τ P' ∥ R'"
by(auto simp add: trancl_into_rtrancl dest: Weak_Early_Step_Semantics.tauTransitionChain)
moreover from P'RelQ' R'BangRelQ'' have "(P' ∥ R', Q' ∥ Q'') ∈ Rel'"
by(rule ParComp)
ultimately show "∃P'. (P ∥ R, P') ∈ {(P, P'). P ⟼ τ ≺ P'}⇧* ∧ (P', Q' ∥ Q'') ∈ Rel'" by auto
qed
qed
next
case(Close1 a x Q' Q'' P)
hence IH: "⋀P. (P, !Q) ∈ bangRel Rel ⟹ ?Sim P (a<νx> ≺ Q'')" by simp
have QTrans: "Q ⟼ a<x> ≺ Q'" by fact
have "(P, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ P" by fact+
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact+
have "x ♯ P ∥ R" by fact
hence xFreshR: "x ♯ R" and xFreshP: "x ♯ P" by simp+
show ?case
proof(auto simp add: residual.inject)
from PRelQ have "P ↝<Rel> Q" by(rule Sim)
with QTrans obtain P' where PTrans: "P ⟹a<x> ≺ P'" and P'RelQ': "(P', Q') ∈ Rel"
by(fastforce dest: simE simp add: weakFreeTransition_def)
from RBangRelQ have "?Sim R (a<νx> ≺ Q'') " by(rule IH)
with xFreshR obtain R' where RTrans: "R ⟹a<νx> ≺ R'"
and R'RelQ'': "(R', Q'') ∈ Rel'"
by(blast dest: simE)
from PTrans RTrans xFreshP have "P ∥ R ⟹τ ≺ <νx>(P' ∥ R')"
by(rule Weak_Early_Step_Semantics.Close1)
moreover from P'RelQ' R'RelQ'' have "(<νx>(P' ∥ R'), <νx>(Q' ∥ Q'')) ∈ Rel'"
by(force intro: ParComp Res)
ultimately show "∃P'. (P ∥ R, P') ∈ {(P, P'). P ⟼ τ ≺ P'}⇧* ∧ (P', <νx>(Q' ∥ Q'')) ∈ Rel'" by auto
qed
qed
next
case(Close2 a x Q' Q'' P)
hence IH: "⋀P. (P, !Q) ∈ bangRel Rel ⟹ ?Sim P (a<x> ≺ Q'')" by simp
have QTrans: "Q ⟼ a<νx> ≺ Q'" by fact
have "(P, Q ∥ !Q) ∈ bangRel Rel" and "x ♯ P" by fact+
thus ?case
proof(induct rule: BRParCases)
case(BRPar P R)
have PRelQ: "(P, Q) ∈ Rel" and RBangRelQ: "(R, !Q) ∈ bangRel Rel" by fact+
have "x ♯ P ∥ R" by fact
hence xFreshP: "x ♯ P" and xFreshR: "x ♯ R" by simp+
show ?case
proof(auto simp add: residual.inject)
from PRelQ have "P ↝<Rel> Q" by(rule Sim)
with QTrans xFreshP obtain P' where PTrans: "P ⟹a<νx> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: simE)
from RBangRelQ have "?Sim R (a<x> ≺ Q'')" by(rule IH)
with xFreshR obtain R' where RTrans: "R ⟹a<x> ≺ R'"
and R'RelQ'': "(R', Q'') ∈ Rel'"
by(fastforce simp add: weakFreeTransition_def)
from PTrans RTrans xFreshR have "P ∥ R ⟹τ ≺ <νx>(P' ∥ R')"
by(rule Weak_Early_Step_Semantics.Close2)
moreover from P'RelQ' R'RelQ'' have "(<νx>(P' ∥ R'), <νx>(Q' ∥ Q'')) ∈ Rel'"
by(force intro: ParComp Res)
ultimately show "∃P'. (P ∥ R, P') ∈ {(P, P'). P ⟼ τ ≺ P'}⇧* ∧ (P', <νx>(Q' ∥ Q'')) ∈ Rel'" by auto
qed
qed
next
case(Bang Rs)
hence IH: "⋀P. (P, Q ∥ !Q) ∈ bangRel Rel ⟹ ?Sim P Rs" by simp
have "(P, !Q) ∈ bangRel Rel" by fact
thus ?case
proof(induct rule: BRBangCases)
case(BRBang P)
have PRelQ: "(P, Q) ∈ Rel" by fact
hence "(!P, !Q) ∈ bangRel Rel" by(rule Rel.BRBang)
with PRelQ have "(P ∥ !P, Q ∥ !Q) ∈ bangRel Rel" by(rule Rel.BRPar)
hence IH: "?Sim (P ∥ !P) Rs" by(rule IH)
show ?case
proof(intro conjI allI impI)
fix Q' a x
assume "Rs = a<νx> ≺ Q'" and "x ♯ !P"
then obtain P' where PTrans: "(P ∥ !P) ⟹a<νx> ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel'" using IH
by(auto simp add: residual.inject)
from PTrans have "!P ⟹a<νx> ≺ P'"
by(force intro: Weak_Early_Step_Semantics.Bang simp add: weakFreeTransition_def)
with P'RelQ' show "∃P'. !P ⟹a<νx> ≺ P' ∧ (P', Q') ∈ Rel'" by blast
next
fix Q' α
assume "Rs = α ≺ Q'"
then obtain P' where PTrans: "(P ∥ !P) ⟹⇧^α ≺ P'"
and P'RelQ': "(P', Q') ∈ Rel'" using IH
by auto
from PTrans show "∃P'. !P ⟹⇧^α ≺ P' ∧ (P', Q') ∈ Rel'" using P'RelQ'
proof(induct rule: transitionCases)
case Step
have "P ∥ !P ⟹α ≺ P'" by fact
hence "!P ⟹α ≺ P'" by(rule Weak_Early_Step_Semantics.Bang)
with P'RelQ' show ?case by(force simp add: weakFreeTransition_def)
next
case Stay
have "!P ⟹⇧^τ ≺ !P" by(simp add: weakFreeTransition_def)
moreover assume "(P ∥ !P, Q') ∈ Rel'"
hence "(!P, Q') ∈ Rel'" by(blast intro: RelStay)
ultimately show ?case by blast
qed
qed
qed
qed
}
moreover from PRelQ have "(!P, !Q) ∈ bangRel Rel" by(rule Rel.BRBang)
ultimately show ?thesis by(auto simp add: weakSimulation_def)
qed
lemma bangRelSim:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
and Rel'l :: "(pi × pi) set"
assumes PBangRelQ: "(P, Q) ∈ bangRel Rel"
and Sim: "⋀R S. (R, S) ∈ Rel ⟹ R ↝<Rel> S"
and ParComp: "⋀R S T U. ⟦(R, S) ∈ Rel; (T, U) ∈ Rel'⟧ ⟹ (R ∥ T, S ∥ U) ∈ Rel'"
and Res: "⋀R S x. (R, S) ∈ Rel' ⟹ (<νx>R, <νx>S) ∈ Rel'"
and RelStay: "⋀R S. (R ∥ !R, S) ∈ Rel' ⟹ (!R, S) ∈ Rel'"
and BangRelRel': "(bangRel Rel) ⊆ Rel'"
and eqvtRel': "eqvt Rel'"
and Eqvt: "eqvt Rel"
shows "P ↝<Rel'> Q"
proof -
from PBangRelQ show ?thesis
proof(induct rule: bangRel.induct)
case(BRBang P Q)
have PRelQ: "(P, Q) ∈ Rel" by fact
thus ?case using ParComp Res BangRelRel' eqvtRel' Eqvt RelStay Sim
by(rule_tac bangPres)
next
case(BRPar P Q R T)
have "(P, Q) ∈ Rel" by fact
moreover hence "P ↝<Rel> Q" by(rule Sim)
moreover have "R ↝<Rel'> T" by fact
moreover have "(R, T) ∈ bangRel Rel" by fact
ultimately show ?case using ParComp eqvtRel' Res Eqvt BangRelRel'
by(blast intro: parCompose)
next
case(BRRes P Q x)
have "P ↝<Rel'> Q" by fact
thus ?case using BangRelRel' eqvtRel' Res by(blast intro: resPres)
qed
qed
end
Theory Strong_Early_Late_Comp
theory Strong_Early_Late_Comp
imports Strong_Late_Bisim_Subst_SC Strong_Early_Bisim_Subst
begin
abbreviation TransitionsLate_judge ("_ ⟼⇩l _" [80, 80] 80) where "P ⟼⇩l Rs ≡ transitions P Rs"
abbreviation TransitionsEarly_judge ("_ ⟼⇩e _" [80, 80] 80) where "P ⟼⇩e Rs ≡ TransitionsEarly P Rs"
abbreviation Transitions_InputjudgeLate ("_<_> ≺⇩l _" [80, 80] 80) where "a<x> ≺⇩l P' ≡ (Late_Semantics.BoundR (Late_Semantics.InputS a) x P')"
abbreviation Transitions_OutputjudgeLate ("_[_] ≺⇩l _" [80, 80] 80) where "a[b] ≺⇩l P' ≡ (Late_Semantics.FreeR (Late_Semantics.OutputR a b) P')"
abbreviation Transitions_BoundOutputjudgeLate ("_<ν_> ≺⇩l _" [80, 80] 80) where "a<νx> ≺⇩l P' ≡ (Late_Semantics.BoundR (Late_Semantics.BoundOutputS a) x P')"
abbreviation Transitions_TaujudgeLate ("τ ≺⇩l _" 80) where "τ ≺⇩l P' ≡ (Late_Semantics.FreeR Late_Semantics.TauR P')"
abbreviation Transitions_InputjudgeEarly ("_<_> ≺⇩e _" [80, 80] 80) where "a<x> ≺⇩e P' ≡ (Early_Semantics.FreeR (Early_Semantics.InputR a x) P')"
abbreviation Transitions_OutputjudgeEarly ("_[_] ≺⇩e _" [80, 80] 80) where "a[b] ≺⇩e P' ≡ (Early_Semantics.FreeR (Early_Semantics.OutputR a b) P')"
abbreviation Transitions_BoundOutputjudgeEarly ("_<ν_> ≺⇩e _" [80, 80] 80) where "a<νx> ≺⇩e P' ≡(Early_Semantics.BoundOutputR a x P')"
abbreviation Transitions_TaujudgeEarly ("τ ≺⇩e _" 80) where "τ ≺⇩e P' ≡ (Early_Semantics.FreeR Early_Semantics.TauR P')"
lemma earlyLateOutput:
fixes P :: pi
and a :: name
and b :: name
and P' :: pi
assumes "P ⟼⇩ea[b] ≺⇩e P'"
shows "P ⟼⇩la[b] ≺⇩l P'"
using assms
proof(nominal_induct rule: Early_Semantics.outputInduct)
case(Output a b P)
show ?case by(rule Late_Semantics.Output)
next
case(Match P a b P' c)
have "P ⟼⇩la[b] ≺⇩l P'" by fact
thus ?case by(rule Late_Semantics.Match)
next
case(Mismatch P a b P' c d)
from ‹P ⟼⇩la[b] ≺⇩l P'› ‹c ≠ d›
show ?case by(rule Late_Semantics.Mismatch)
next
case(Sum1 P a b P' Q)
have "P ⟼⇩la[b] ≺⇩l P'" by fact
thus ?case by(rule Late_Semantics.Sum1)
next
case(Sum2 Q a b Q' P)
have "Q ⟼⇩la[b] ≺⇩l Q'" by fact
thus ?case by(rule Late_Semantics.Sum2)
next
case(Par1 P a b P' Q)
have "P ⟼⇩la[b] ≺⇩l P'" by fact
thus ?case by(rule Late_Semantics.Par1F)
next
case(Par2 Q a b Q' P)
have "Q ⟼⇩la[b] ≺⇩l Q'" by fact
thus ?case by(rule Late_Semantics.Par2F)
next
case(Res P a b P' x)
have "P ⟼⇩la[b] ≺⇩l P'" and "x ≠ a" and "x ≠ b" by fact+
thus ?case by(force intro: Late_Semantics.ResF)
next
case(Bang P a b P')
have "P ∥ !P ⟼⇩la[b] ≺⇩l P'" by fact
thus ?case by(rule Late_Semantics.Bang)
qed
lemma lateEarlyOutput:
fixes P :: pi
and a :: name
and b :: name
and P' :: pi
assumes "P ⟼⇩la[b] ≺⇩l P'"
shows "P ⟼⇩ea[b] ≺⇩e P'"
using assms
proof(nominal_induct rule: Late_Semantics.outputInduct)
case(Output a b P)
thus ?case by(rule Early_Semantics.Output)
next
case(Match P a b P' c)
have "P ⟼⇩ea[b] ≺⇩e P'" by fact
thus ?case by(rule Early_Semantics.Match)
next
case(Mismatch P a b P' c d)
have "P ⟼⇩ea[b] ≺⇩e P'" and "c ≠ d" by fact+
thus ?case by(rule Early_Semantics.Mismatch)
next
case(Sum1 P a b P' Q)
have "P ⟼⇩ea[b] ≺⇩e P'" by fact
thus ?case by(rule Early_Semantics.Sum1)
next
case(Sum2 Q a b Q' P)
have "Q ⟼⇩ea[b] ≺⇩e Q'" by fact
thus ?case by(rule Early_Semantics.Sum2)
next
case(Par1 P a b P' Q)
have "P ⟼⇩ea[b] ≺⇩e P'" by fact
thus ?case by(rule Early_Semantics.Par1F)
next
case(Par2 Q a b Q' P)
have "Q ⟼⇩ea[b] ≺⇩e Q'" by fact
thus ?case by(rule Early_Semantics.Par2F)
next
case(Res P a b P' x)
have "P ⟼⇩ea[b] ≺⇩e P'" and "x ≠ a" and "x ≠ b" by fact+
thus ?case by(force intro: Early_Semantics.ResF)
next
case(Bang P a b P')
have "P ∥ !P ⟼⇩ea[b] ≺⇩e P'" by fact
thus ?case by(rule Early_Semantics.Bang)
qed
lemma outputEq:
fixes P :: pi
and a :: name
and b :: name
and P' :: pi
shows "P ⟼⇩ea[b] ≺⇩e P' = P ⟼⇩la[b] ≺⇩l P'"
by(auto intro: lateEarlyOutput earlyLateOutput)
lemma lateEarlyBoundOutput:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
assumes "P ⟼⇩la<νx> ≺⇩l P'"
shows "P ⟼⇩ea<νx> ≺⇩e P'"
proof -
have Goal: "⋀P a x P'. ⟦P ⟼⇩la<νx> ≺⇩l P'; x ♯ P⟧ ⟹ P ⟼⇩ea<νx> ≺⇩e P'"
proof -
fix P a x P'
assume "P ⟼⇩l a<νx> ≺⇩l P'" and "x ♯ P"
thus "P ⟼⇩ea<νx> ≺⇩e P'"
proof(nominal_induct rule: Late_Semantics.boundOutputInduct)
case(Match P a x P' b)
have "P ⟼⇩e a<νx> ≺⇩e P'" by fact
thus ?case by(rule Early_Semantics.Match)
next
case(Mismatch P a x P' b c)
have "P ⟼⇩e a<νx> ≺⇩e P'" and "b ≠ c" by fact+
thus ?case by(rule Early_Semantics.Mismatch)
next
case(Open P a x P')
have "P ⟼⇩la[x] ≺⇩l P'" by fact
hence "P ⟼⇩ea[x] ≺⇩e P'" by(rule lateEarlyOutput)
moreover have "a ≠ x" by fact
ultimately show ?case by(rule Early_Semantics.Open)
next
case(Sum1 P Q a x P')
have "P ⟼⇩e a<νx> ≺⇩e P'" by fact
thus ?case by(rule Early_Semantics.Sum1)
next
case(Sum2 P Q a x Q')
have "Q ⟼⇩e a<νx> ≺⇩e Q'" by fact
thus ?case by(rule Early_Semantics.Sum2)
next
case(Par1 P P' Q a x)
have "P ⟼⇩e a<νx> ≺⇩e P'" and "x ♯ Q" by fact+
thus ?case by(rule Early_Semantics.Par1B)
next
case(Par2 P Q Q' a x)
have "Q ⟼⇩e a<νx> ≺⇩e Q'" and "x ♯ P" by fact+
thus ?case by(rule Early_Semantics.Par2B)
next
case(Res P P' a x y)
have "P ⟼⇩e a<νx> ≺⇩e P'" and "y ≠ a" and "y ≠ x" by fact+
thus ?case by(force intro: Early_Semantics.ResB)
next
case(Bang P a x P')
have "P ∥ !P ⟼⇩e a<νx> ≺⇩e P'" by fact
thus ?case by(rule Early_Semantics.Bang)
qed
qed
have "∃c::name. c ♯ (P, P', x)" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshP: "c ♯ P" and cFreshP': "c ♯ P'" and "c ≠ x"
by(force simp add: fresh_prod)
from assms cFreshP' have "P ⟼⇩la<νc> ≺⇩l ([(x, c)] ∙ P')"
by(simp add: Late_Semantics.alphaBoundResidual)
hence "P ⟼⇩e a<νc> ≺⇩e ([(x, c)] ∙ P')" using cFreshP
by(rule Goal)
moreover from cFreshP' ‹c ≠ x› have "x ♯ [(x, c)] ∙ P'" by(simp add: name_fresh_left name_calc)
ultimately show ?thesis by(simp add: Early_Semantics.alphaBoundOutput name_swap)
qed
lemma earlyLateBoundOutput:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
assumes "P ⟼⇩ea<νx> ≺⇩e P'"
shows "P ⟼⇩la<νx> ≺⇩l P'"
proof -
have Goal: "⋀P a x P'. ⟦P ⟼⇩ea<νx> ≺⇩e P'; x ♯ P⟧ ⟹ P ⟼⇩la<νx> ≺⇩l P'"
proof -
fix P a x P'
assume "P ⟼⇩e a<νx> ≺ P'" and "x ♯ P"
thus "P ⟼⇩la<νx> ≺⇩l P'"
proof(nominal_induct rule: Early_Semantics.boundOutputInduct)
case(Match P a x P' b)
have "P ⟼⇩l a<νx> ≺ P'" by fact
thus ?case by(rule Late_Semantics.Match)
next
case(Mismatch P a x P' b c)
have "P ⟼⇩l a<νx> ≺ P'" and "b ≠ c" by fact+
thus ?case by(rule Late_Semantics.Mismatch)
next
case(Open P a x P')
have "P ⟼⇩ea[x] ≺⇩e P'" by fact
hence "P ⟼⇩la[x] ≺⇩l P'" by(rule earlyLateOutput)
moreover have "a ≠ x" by fact
ultimately show ?case by(rule Late_Semantics.Open)
next
case(Sum1 P Q a x P')
have "P ⟼⇩l a<νx> ≺⇩l P'" by fact
thus ?case by(rule Late_Semantics.Sum1)
next
case(Sum2 P Q a x Q')
have "Q ⟼⇩l a<νx> ≺⇩l Q'" by fact
thus ?case by(rule Late_Semantics.Sum2)
next
case(Par1 P P' Q a x)
have "P ⟼⇩l a<νx> ≺⇩l P'" and "x ♯ Q" by fact+
thus ?case by(rule Late_Semantics.Par1B)
next
case(Par2 P Q Q' a x)
have "Q ⟼⇩l a<νx> ≺⇩l Q'" and "x ♯ P" by fact+
thus ?case by(rule Late_Semantics.Par2B)
next
case(Res P P' a x y)
have "P ⟼⇩l a<νx> ≺⇩l P'" and "y ≠ a" and "y ≠ x" by fact+
thus ?case by(force intro: Late_Semantics.ResB)
next
case(Bang P a x P')
have "P ∥ !P ⟼⇩l a<νx> ≺ P'" by fact
thus ?case by(rule Late_Semantics.Bang)
qed
qed
have "∃c::name. c ♯ (P, P', x)" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshP: "c ♯ P" and cFreshP': "c ♯ P'" and "c ≠ x"
by(force simp add: fresh_prod)
from assms cFreshP' have "P ⟼⇩ea<νc> ≺⇩e ([(x, c)] ∙ P')"
by(simp add: Early_Semantics.alphaBoundOutput)
hence "P ⟼⇩l a<νc> ≺⇩l ([(x, c)] ∙ P')" using cFreshP
by(rule Goal)
moreover from cFreshP' ‹c ≠ x› have "x ♯ [(x, c)] ∙ P'" by(simp add: name_fresh_left name_calc)
ultimately show ?thesis by(simp add: Late_Semantics.alphaBoundResidual name_swap)
qed
lemma BoundOutputEq:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
shows "P ⟼⇩ea<νx> ≺⇩e P' = P ⟼⇩la<νx> ≺⇩l P'"
by(auto intro: earlyLateBoundOutput lateEarlyBoundOutput)
lemma lateEarlyInput:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
and u :: name
assumes PTrans: "P ⟼⇩l a<x> ≺⇩l P'"
shows "P ⟼⇩ea<u> ≺⇩e (P'[x::=u])"
proof -
have Goal: "⋀P a x P' u. ⟦P ⟼⇩l a<x> ≺⇩l P'; x ♯ P⟧ ⟹ P ⟼⇩e a<u> ≺⇩e (P'[x::=u])"
proof -
fix P a x P' u
assume "P ⟼⇩l a<x> ≺⇩l P'" and "x ♯ P"
thus "P ⟼⇩e a<u> ≺⇩e (P'[x::=u])"
proof(nominal_induct avoiding: u rule: Late_Semantics.inputInduct)
case(Input a x P)
thus ?case by(rule Early_Semantics.Input)
next
case(Match P a x P' b u)
have "P ⟼⇩ea<u> ≺⇩e (P'[x::=u])" by fact
thus ?case by(rule Early_Semantics.Match)
next
case(Mismatch P a x P' b c u)
have "P ⟼⇩ea<u> ≺⇩e (P'[x::=u])" by fact
moreover have "b≠c" by fact
ultimately show ?case by(rule Early_Semantics.Mismatch)
next
case(Sum1 P Q a x P')
have "P ⟼⇩ea<u> ≺⇩e (P'[x::=u])" by fact
thus ?case by(rule Early_Semantics.Sum1)
next
case(Sum2 P Q a x Q')
have "Q ⟼⇩ea<u> ≺⇩e (Q'[x::=u])" by fact
thus ?case by(rule Early_Semantics.Sum2)
next
case(Par1 P P' Q a x)
have "P ⟼⇩ea<u> ≺⇩e (P'[x::=u])" by fact
hence "P ∥ Q ⟼⇩ea<u> ≺⇩e (P'[x::=u] ∥ Q)" by(rule Early_Semantics.Par1F)
moreover have "x ♯ Q" by fact
ultimately show ?case by(simp add: forget)
next
case(Par2 P Q Q' a x)
have "Q ⟼⇩ea<u> ≺⇩e (Q'[x::=u])" by fact
hence "P ∥ Q ⟼⇩ea<u> ≺⇩e (P ∥ Q'[x::=u])" by(rule Early_Semantics.Par2F)
moreover have "x ♯ P" by fact
ultimately show ?case by(simp add: forget)
next
case(Res P P' a x y u)
have "P ⟼⇩ea<u> ≺⇩e (P'[x::=u])" and "y ≠ a" and yinequ: "y ♯ u" by fact+
hence "<νy>P ⟼⇩ea<u> ≺⇩e <νy>(P'[x::=u])" by(force intro: Early_Semantics.ResF)
moreover have "y ≠ x" by fact
ultimately show ?case using yinequ by simp
next
case(Bang P a x P' u)
have "P ∥ !P ⟼⇩ea<u> ≺⇩e (P'[x::=u])" by fact
thus ?case by(rule Early_Semantics.Bang)
qed
qed
have "∃c::name. c ♯ (P, P')" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshP: "c ♯ P" and cFreshP': "c ♯ P'"
by(force simp add: fresh_prod)
from assms cFreshP' have "P ⟼⇩la<c> ≺⇩l ([(x, c)] ∙ P')"
by(simp add: Late_Semantics.alphaBoundResidual)
hence "P ⟼⇩e a<u> ≺⇩e ([(x, c)] ∙ P')[c::=u]" using cFreshP
by(rule Goal)
with cFreshP' show ?thesis by(simp add: renaming name_swap)
qed
lemma earlyLateInput:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
and u :: name
and C :: "'a::fs_name"
assumes "P ⟼⇩ea<u> ≺⇩e P'"
and "x ♯ P"
shows "∃P''. P ⟼⇩la<x> ≺⇩l P'' ∧ P' = P''[x::=u]"
proof -
{
fix P a u P'
assume "P ⟼⇩ea<u> ≺⇩e P'"
hence "∃P'' x. P ⟼⇩la<x> ≺⇩l P'' ∧ P' = P''[x::=u]"
proof(nominal_induct rule: Early_Semantics.inputInduct)
case(cInput a x P u)
have "a<x>.P ⟼⇩la<x> ≺ P" by(rule Late_Semantics.Input)
thus ?case by blast
next
case(cMatch P a u P' b)
have "∃P'' x. P ⟼⇩la<x> ≺ P'' ∧ P' = P''[x::=u]" by fact
then obtain P'' x where PTrans: "P ⟼⇩la<x> ≺ P''" and P'eqP'': "P' = P''[x::=u]" by blast
from PTrans have "[b⌢b]P ⟼⇩la<x> ≺ P''" by(rule Late_Semantics.Match)
with P'eqP'' show ?case by blast
next
case(cMismatch P a u P' b c)
have "∃P'' x. P ⟼⇩la<x> ≺ P'' ∧ P' = P''[x::=u]" by fact
then obtain P'' x where PTrans: "P ⟼⇩la<x> ≺ P''" and P'eqP'': "P' = P''[x::=u]" by blast
have "b ≠ c" by fact
with PTrans have "[b≠c]P ⟼⇩la<x> ≺ P''" by(rule Late_Semantics.Mismatch)
with P'eqP'' show ?case by blast
next
case(cSum1 P a u P' Q)
have "∃P'' x. P ⟼⇩la<x> ≺ P'' ∧ P' = P''[x::=u]" by fact
then obtain P'' x where PTrans: "P ⟼⇩la<x> ≺ P''" and P'eqP'': "P' = P''[x::=u]" by blast
from PTrans have "P ⊕ Q ⟼⇩la<x> ≺ P''" by(rule Late_Semantics.Sum1)
with P'eqP'' show ?case by blast
next
case(cSum2 Q a u Q' P)
have "∃Q'' x. Q ⟼⇩la<x> ≺ Q'' ∧ Q' = Q''[x::=u]" by fact
then obtain Q'' x where QTrans: "Q ⟼⇩la<x> ≺ Q''" and Q'eqQ'': "Q' = Q''[x::=u]" by blast
from QTrans have "P ⊕ Q ⟼⇩la<x> ≺ Q''" by(rule Late_Semantics.Sum2)
with Q'eqQ'' show ?case by blast
next
case(cPar1 P a u P' Q)
have "∃P'' x. P ⟼⇩la<x> ≺ P'' ∧ P' = P''[x::=u]" by fact
then obtain P'' x where PTrans: "P ⟼⇩la<x> ≺ P''" and P'eqP'': "P' = P''[x::=u]" by blast
have "∃c::name. c ♯ (Q, P'')" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshQ: "c ♯ Q" and cFreshP'': "c ♯ P''" by(force simp add: fresh_prod)
from PTrans cFreshP'' have "P ⟼⇩la<c> ≺ [(x, c)] ∙ P''" by(simp add: Late_Semantics.alphaBoundResidual)
hence "P ∥ Q ⟼⇩la<c> ≺ ([(x, c)] ∙ P'') ∥ Q" using ‹c ♯ Q› by(rule Late_Semantics.Par1B)
moreover from cFreshQ cFreshP'' P'eqP'' have "P' ∥ Q = (([(x, c)] ∙ P'') ∥ Q)[c::=u]"
by(simp add: forget renaming name_swap)
ultimately show ?case by blast
next
case(cPar2 Q a u Q' P)
have "∃Q'' x. Q ⟼⇩la<x> ≺ Q'' ∧ Q' = Q''[x::=u]" by fact
then obtain Q'' x where QTrans: "Q ⟼⇩la<x> ≺ Q''" and Q'eqQ'': "Q' = Q''[x::=u]" by blast
have "∃c::name. c ♯ (P, Q'')" by(blast intro: name_exists_fresh)
then obtain c::name where cFreshP: "c ♯ P" and cFreshQ'': "c ♯ Q''" by(force simp add: fresh_prod)
from QTrans cFreshQ'' have "Q ⟼⇩la<c> ≺ [(x, c)] ∙ Q''" by(simp add: Late_Semantics.alphaBoundResidual)
hence "P ∥ Q ⟼⇩la<c> ≺ P ∥ ([(x, c)] ∙ Q'')" using ‹c ♯ P› by(rule Late_Semantics.Par2B)
moreover from cFreshP cFreshQ'' Q'eqQ'' have "P ∥ Q' = (P ∥ ([(x, c)] ∙ Q''))[c::=u]"
by(simp add: forget renaming name_swap)
ultimately show ?case by blast
next
case(cRes P a u P' y)
have "∃P'' x. P ⟼⇩la<x> ≺ P'' ∧ P' = P''[x::=u]" by fact
then obtain P'' x where PTrans: "P ⟼⇩la<x> ≺ P''" and P'eqP'': "P' = P''[x::=u]" by blast
have yinequ: "y ≠ u" by fact
have "∃c::name. c ♯ (y, P'')" by(blast intro: name_exists_fresh)
then obtain c::name where cineqy: "c ≠ y" and cFreshP'': "c ♯ P''" by(force simp add: fresh_prod)
from PTrans cFreshP'' have "P ⟼⇩la<c> ≺ [(x, c)] ∙ P''" by(simp add: Late_Semantics.alphaBoundResidual)
moreover have "y ≠ a" by fact
ultimately have "<νy>P ⟼⇩la<c> ≺ <νy>(([(x, c)] ∙ P''))" using cineqy
by(force intro: Late_Semantics.ResB)
moreover from cineqy cFreshP'' P'eqP'' yinequ have "<νy>P' = (<νy>([(x, c)] ∙ P''))[c::=u]"
by(simp add: renaming name_swap)
ultimately show ?case by blast
next
case(cBang P a u P')
have "∃P'' x. P ∥ !P ⟼⇩la<x> ≺ P'' ∧ P' = P''[x::=u]" by fact
then obtain P'' x where PTrans: "P ∥ !P ⟼⇩la<x> ≺ P''" and P'eqP'': "P' = P''[x::=u]" by blast
from PTrans have "!P ⟼⇩la<x> ≺ P''" by(rule Late_Semantics.Bang)
with P'eqP'' show ?case by blast
qed
}
with assms obtain P'' y where PTrans: "P ⟼⇩la<y> ≺ P''" and P'eqP'': "P' = P''[y::=u]" by blast
show ?thesis
proof(cases "x=y")
case True
from PTrans P'eqP'' ‹x = y› show ?thesis by blast
next
case False
from PTrans ‹x ≠ y› ‹x ♯ P› have "x ♯ P''" by(fastforce dest: freshBoundDerivative simp add: residual.inject)
with PTrans have "P ⟼⇩la<x> ≺⇩l ([(x, y)] ∙ P'')"
by(simp add: Late_Semantics.alphaBoundResidual)
moreover from ‹x ♯ P''› have "P''[y::=u] = ([(x, y)] ∙ P'')[x::=u]" by(simp add: renaming name_swap)
ultimately show ?thesis using P'eqP'' by blast
qed
qed
lemma lateEarlyTau:
fixes P :: pi
and P' :: pi
assumes "P ⟼⇩lτ ≺⇩l P'"
shows "P ⟼⇩eτ ≺⇩e P'"
using assms
proof(nominal_induct rule: Late_Semantics.tauInduct)
case(Tau P)
thus ?case by(rule Early_Semantics.Tau)
next
case(Match P P' a)
have "P ⟼⇩eτ ≺⇩e P'" by fact
thus "[a⌢a]P ⟼⇩eτ ≺⇩e P'" by(rule Early_Semantics.Match)
next
case(Mismatch P P' a b)
have "P ⟼⇩eτ ≺⇩e P'" by fact
moreover have "a ≠ b" by fact
ultimately show "[a≠b]P ⟼⇩eτ ≺⇩e P'" by(rule Early_Semantics.Mismatch)
next
case(Sum1 P P' Q)
have "P ⟼⇩eτ ≺⇩e P'" by fact
thus "P ⊕ Q ⟼⇩eτ ≺⇩e P'" by(rule Early_Semantics.Sum1)
next
case(Sum2 Q Q' P)
have "Q ⟼⇩eτ ≺⇩e Q'" by fact
thus "P ⊕ Q ⟼⇩eτ ≺⇩e Q'" by(rule Early_Semantics.Sum2)
next
case(Par1 P P' Q)
have "P ⟼⇩eτ ≺⇩e P'" by fact
thus "P ∥ Q ⟼⇩eτ ≺⇩e P' ∥ Q" by(rule Early_Semantics.Par1F)
next
case(Par2 Q Q' P)
have "Q ⟼⇩eτ ≺⇩e Q'" by fact
thus "P ∥ Q ⟼⇩eτ ≺⇩e P ∥ Q'" by(rule Early_Semantics.Par2F)
next
case(Comm1 P a x P' Q b Q')
have "P ⟼⇩ea<b> ≺⇩e P'[x::=b]"
proof -
have "P ⟼⇩l a<x> ≺ P'" by fact
thus ?thesis by(rule lateEarlyInput)
qed
moreover have "Q ⟼⇩ea[b] ≺⇩e Q'"
proof -
have "Q ⟼⇩la[b] ≺⇩l Q'" by fact
thus ?thesis by(rule lateEarlyOutput)
qed
ultimately show ?case by(rule Early_Semantics.Comm1)
next
case(Comm2 P a b P' Q x Q')
have "P ⟼⇩ea[b] ≺⇩e P'"
proof -
have "P ⟼⇩la[b] ≺⇩l P'" by fact
thus ?thesis by(rule lateEarlyOutput)
qed
moreover have "Q ⟼⇩ea<b> ≺⇩e Q'[x::=b]"
proof -
have "Q ⟼⇩la<x> ≺⇩l Q'" by fact
thus ?thesis by(rule lateEarlyInput)
qed
ultimately show ?case by(rule Early_Semantics.Comm2)
next
case(Close1 P a x P' Q y Q')
have "P ⟼⇩ea<y> ≺⇩e P'[x::=y]"
proof -
have "P ⟼⇩l a<x> ≺ P'" by fact
thus ?thesis by(rule lateEarlyInput)
qed
moreover have "Q ⟼⇩ea<νy> ≺ Q'"
proof -
have "Q ⟼⇩la<νy> ≺⇩l Q'" by fact
thus ?thesis by(rule lateEarlyBoundOutput)
qed
moreover have "y ♯ P" by fact
ultimately show ?case by(rule Early_Semantics.Close1)
next
case(Close2 P a y P' Q x Q')
have "P ⟼⇩ea<νy> ≺ P'"
proof -
have "P ⟼⇩la<νy> ≺⇩l P'" by fact
thus ?thesis by(rule lateEarlyBoundOutput)
qed
moreover have "Q ⟼⇩ea<y> ≺⇩e Q'[x::=y]"
proof -
have "Q ⟼⇩la<x> ≺⇩l Q'" by fact
thus ?thesis by(rule lateEarlyInput)
qed
moreover have "y ♯ Q" by fact
ultimately show ?case by(rule Early_Semantics.Close2)
next
case(Res P P' x)
have "P ⟼⇩eτ ≺⇩e P'" by fact
thus ?case by(force intro: Early_Semantics.ResF)
next
case(Bang P P')
have "P ∥ !P ⟼⇩eτ ≺⇩e P'" by fact
thus ?case by(rule Early_Semantics.Bang)
qed
lemma earlyLateTau:
fixes P :: pi
and P' :: pi
assumes "P ⟼⇩eτ ≺⇩e P'"
shows "P ⟼⇩lτ ≺⇩l P'"
using assms
proof(nominal_induct rule: Early_Semantics.tauInduct)
case(Tau P)
thus ?case by(rule Late_Semantics.Tau)
next
case(Match P P' a)
have "P ⟼⇩lτ ≺⇩l P'" by fact
thus ?case by(rule Late_Semantics.Match)
next
case(Mismatch P P' a b)
have "P ⟼⇩lτ ≺⇩l P'" by fact
moreover have "a ≠ b" by fact
ultimately show ?case by(rule Late_Semantics.Mismatch)
next
case(Sum1 P P' Q)
have "P ⟼⇩lτ ≺⇩l P'" by fact
thus ?case by(rule Late_Semantics.Sum1)
next
case(Sum2 Q Q' P)
have "Q ⟼⇩lτ ≺⇩l Q'" by fact
thus ?case by(rule Late_Semantics.Sum2)
next
case(Par1 P P' Q)
have "P ⟼⇩lτ ≺⇩l P'" by fact
thus ?case by(rule Late_Semantics.Par1F)
next
case(Par2 Q Q' P)
have "Q ⟼⇩lτ ≺⇩l Q'" by fact
thus ?case by(rule Late_Semantics.Par2F)
next
case(Comm1 P a b P' Q Q')
have "P ⟼⇩ea<b> ≺⇩e P'" by fact
moreover obtain x::name where "x ♯ P" by(generate_fresh "name") auto
ultimately obtain P'' where PTrans: "P ⟼⇩la<x> ≺ P''" and P'eqP'': "P' = P''[x::=b]"
by(blast dest: earlyLateInput)
have "Q ⟼⇩ea[b] ≺⇩e Q'" by fact
hence "Q ⟼⇩la[b] ≺⇩l Q'" by(rule earlyLateOutput)
with PTrans P'eqP'' show ?case
by(blast intro: Late_Semantics.Comm1)
next
case(Comm2 P a b P' Q Q')
have "P ⟼⇩ea[b] ≺⇩e P'" by fact
hence QTrans: "P ⟼⇩la[b] ≺⇩l P'" by(rule earlyLateOutput)
have "Q ⟼⇩ea<b> ≺⇩e Q'" by fact
moreover obtain x::name where "x ♯ Q" by(generate_fresh "name") auto
ultimately obtain Q'' x where "Q ⟼⇩la<x> ≺ Q''" and "Q' = Q''[x::=b]"
by(blast dest: earlyLateInput)
with QTrans show ?case
by(blast intro: Late_Semantics.Comm2)
next
case(Close1 P a x P' Q Q')
have "P ⟼⇩ea<x> ≺⇩e P'" and "x ♯ P" by fact+
then obtain P'' where "P ⟼⇩la<x> ≺ P''" and "P' = P''[x::=x]"
by(blast dest: earlyLateInput)
moreover have "Q ⟼⇩ea<νx> ≺⇩e Q'" by fact
hence "Q ⟼⇩la<νx> ≺⇩l Q'" by(rule earlyLateBoundOutput)
moreover have "x ♯ P" by fact
ultimately show ?case
by(blast intro: Late_Semantics.Close1)
next
case(Close2 P a x P' Q Q')
have "P ⟼⇩ea<νx> ≺⇩e P'" by fact
hence PTrans: "P ⟼⇩la<νx> ≺⇩l P'" by(rule earlyLateBoundOutput)
have "Q ⟼⇩ea<x> ≺⇩e Q'" and "x ♯ Q" by fact+
then obtain Q'' y where "Q ⟼⇩la<x> ≺ Q''" and "Q' = Q''[x::=x]"
by(blast dest: earlyLateInput)
moreover have "x ♯ Q" by fact
ultimately show ?case using PTrans
by(blast intro: Late_Semantics.Close2)
next
case(Res P P' x)
have "P ⟼⇩lτ ≺⇩l P'" by fact
thus ?case by(force intro: Late_Semantics.ResF)
next
case(Bang P P')
have "P ∥ !P ⟼⇩lτ ≺⇩l P'" by fact
thus ?case by(force intro: Late_Semantics.Bang)
qed
lemma tauEq:
fixes P :: pi
and P' :: pi
shows "P ⟼⇩e(Early_Semantics.FreeR Early_Semantics.TauR P') = P ⟼τ ≺⇩l P'"
by(auto intro: earlyLateTau lateEarlyTau)
abbreviation simLate_judge ("_ ↝⇩l[_] _" [80, 80, 80] 80) where "P ↝⇩l[Rel] Q ≡ Strong_Late_Sim.simulation P Rel Q"
abbreviation simEarly_judge ("_ ↝⇩e[_] _" [80, 80, 80] 80) where "P ↝⇩e[Rel] Q ≡ Strong_Early_Sim.strongSimEarly P Rel Q"
lemma lateEarlySim:
fixes P :: pi
and Q :: pi
and Rel :: "(pi × pi) set"
assumes PSimQ: "P ↝⇩l[Rel] Q"
shows "P ↝⇩e[Rel] Q"
proof(induct rule: Strong_Early_Sim.simCases)
case(Bound a x Q')
have "Q ⟼⇩ea<νx> ≺⇩e Q'" by fact
hence "Q ⟼⇩la<νx> ≺⇩l Q'" by(rule earlyLateBoundOutput)
moreover have "x ♯ P" by fact
ultimately obtain P' where PTrans: "P ⟼⇩la<νx> ≺⇩l P'" and P'RelQ': "(P', Q') ∈ Rel" using PSimQ
by(force dest: Strong_Late_Sim.simE simp add: derivative_def)
from PTrans have "P ⟼⇩ea<νx> ≺⇩e P'" by(rule lateEarlyBoundOutput)
with P'RelQ' show ?case by blast
next
case(Free α Q')
have "Q ⟼⇩e Early_Semantics.residual.FreeR α Q'" by fact
thus ?case
proof(nominal_induct α rule: freeRes.strong_induct)
case(InputR a u)
obtain x::name where "x ♯ Q" and "x ♯ P" by(generate_fresh "name") auto
with ‹Q ⟼⇩ea<u> ≺⇩e Q'› obtain Q'' where QTrans: "Q ⟼⇩la<x> ≺⇩l Q''" and Q'eqQ'': "Q' = Q''[x::=u]"
by(blast dest: earlyLateInput)
from PSimQ QTrans ‹x ♯ P› obtain P' where PTrans: "P ⟼⇩la<x> ≺ P'"
and P'RelQ': "(P'[x::=u], Q''[x::=u]) ∈ Rel"
by(force dest: Strong_Late_Sim.simE simp add: derivative_def)
from PTrans have "P ⟼⇩ea<u> ≺⇩e P'[x::=u]" by(rule lateEarlyInput)
with P'RelQ' Q'eqQ'' show "∃P'. P ⟼⇩ea<u> ≺⇩e P' ∧ (P', Q') ∈ Rel" by blast
next
case(OutputR a b)
from ‹Q ⟼⇩ea[b] ≺⇩e Q'› have "Q ⟼⇩la[b] ≺⇩l Q'" by(rule earlyLateOutput)
with PSimQ obtain P' where PTrans: "P ⟼⇩la[b] ≺⇩l P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: Strong_Late_Sim.simE)
from PTrans have "P ⟼⇩ea[b] ≺⇩e P'" by(rule lateEarlyOutput)
with P'RelQ' show "∃P'. P ⟼⇩ea[b] ≺⇩e P' ∧ (P', Q') ∈ Rel" by blast
next
case TauR
from ‹Q ⟼⇩eτ ≺⇩e Q'› have "Q ⟼⇩lτ ≺⇩l Q'" by(rule earlyLateTau)
with PSimQ obtain P' where PTrans: "P ⟼⇩lτ ≺⇩l P'" and P'RelQ': "(P', Q') ∈ Rel"
by(blast dest: Strong_Late_Sim.simE)
from PTrans have "P ⟼⇩eτ ≺⇩e P'" by(rule lateEarlyTau)
with P'RelQ' show "∃P'. P ⟼⇩eτ ≺⇩e P' ∧ (P', Q') ∈ Rel" by blast
qed
qed
abbreviation bisimLate_judge ("_ ∼⇩l _" [80, 80] 80) where "P ∼⇩l Q ≡ (P, Q) ∈ Strong_Late_Bisim.bisim"
abbreviation bisimEarly_judge ("_ ∼⇩e _" [80, 80] 80) where "P ∼⇩e Q ≡ (P, Q) ∈ Strong_Early_Bisim.bisim"
lemma lateEarlyBisim:
fixes P :: pi
and Q :: pi
assumes "P ∼⇩l Q"
shows "P ∼⇩e Q"
using assms
by(coinduct rule: Strong_Early_Bisim.weak_coinduct)
(auto dest: Strong_Late_Bisim.bisimE Strong_Late_Bisim.symmetric intro: lateEarlySim)
abbreviation congLate_judge ("_ ∼⇧s⇩l _" [80, 80] 80) where "P ∼⇧s⇩l Q ≡ (P, Q) ∈ (substClosed Strong_Late_Bisim.bisim)"
abbreviation congEarly_judge ("_ ∼⇧s⇩e _" [80, 80] 80) where "P ∼⇧s⇩e Q ≡ (P, Q) ∈ (substClosed Strong_Early_Bisim.bisim)"
lemma lateEarlyCong:
fixes P :: pi
and Q :: pi
assumes "P ∼⇧s⇩l Q"
shows "P ∼⇧s⇩e Q"
using assms
by(auto simp add: substClosed_def intro: lateEarlyBisim)
lemma earlyCongStructCong:
fixes P :: pi
and Q :: pi
assumes "P ≡⇩s Q"
shows "P ∼⇧s⇩e Q"
using assms lateEarlyCong bisimSubstStructCong
by blast
lemma earlyBisimStructCong:
fixes P :: pi
and Q :: pi
assumes "P ≡⇩s Q"
shows "P ∼⇩e Q"
using assms lateEarlyBisim structCongBisim
by blast
end
Theory Strong_Early_Bisim_SC
theory Strong_Early_Bisim_SC
imports Strong_Early_Bisim Strong_Late_Bisim_SC Strong_Early_Late_Comp
begin
lemma resComm:
fixes P :: pi
shows "<νa><νb>P ∼⇩e <νb><νa>P"
proof -
have "<νa><νb>P ∼⇩l <νb><νa>P" by(rule Strong_Late_Bisim_SC.resComm)
thus ?thesis by(rule lateEarlyBisim)
qed
lemma matchId:
fixes a :: name
and P :: pi
shows "[a⌢a]P ∼⇩e P"
proof -
have "[a⌢a]P ∼⇩l P" by(rule Strong_Late_Bisim_SC.matchId)
thus ?thesis by(rule lateEarlyBisim)
qed
lemma mismatchId:
fixes a :: name
and b :: name
and P :: pi
assumes "a ≠ b"
shows "[a≠b]P ∼⇩e P"
proof -
from assms have "[a≠b]P ∼⇩l P" by(rule Strong_Late_Bisim_SC.mismatchId)
thus ?thesis by(rule lateEarlyBisim)
qed
lemma mismatchNil:
fixes a :: name
and P :: pi
shows "[a≠a]P ∼⇩e 𝟬"
proof -
have "[a≠a]P ∼⇩l 𝟬" by(rule Strong_Late_Bisim_SC.mismatchNil)
thus ?thesis by(rule lateEarlyBisim)
qed
lemma sumSym:
fixes P :: pi
and Q :: pi
shows "P ⊕ Q ∼⇩e Q ⊕ P"
proof -
have "P ⊕ Q ∼⇩l Q ⊕ P" by(rule Strong_Late_Bisim_SC.sumSym)
thus ?thesis by(rule lateEarlyBisim)
qed
lemma sumAssoc:
fixes P :: pi
and Q :: pi
and R :: pi
shows "(P ⊕ Q) ⊕ R ∼⇩e P ⊕ (Q ⊕ R)"
proof -
have "(P ⊕ Q) ⊕ R ∼⇩l P ⊕ (Q ⊕ R)" by(rule Strong_Late_Bisim_SC.sumAssoc)
thus ?thesis by(rule lateEarlyBisim)
qed
lemma sumZero:
fixes P :: pi
shows "P ⊕ 𝟬 ∼⇩e P"
proof -
have "P ⊕ 𝟬 ∼⇩l P" by(rule Strong_Late_Bisim_SC.sumZero)
thus ?thesis by(rule lateEarlyBisim)
qed
lemma parZero:
fixes P :: pi
shows "P ∥ 𝟬 ∼⇩e P"
proof -
have "P ∥ 𝟬 ∼⇩l P" by(rule Strong_Late_Bisim_SC.parZero)
thus ?thesis by(rule lateEarlyBisim)
qed
lemma parSym:
fixes P :: pi
and Q :: pi
shows "P ∥ Q ∼⇩e Q ∥ P"
proof -
have "P ∥ Q ∼⇩l Q ∥ P" by(rule Strong_Late_Bisim_SC.parSym)
thus ?thesis by(rule lateEarlyBisim)
qed
lemma scopeExtPar:
fixes P :: pi
and Q :: pi
and x :: name
assumes "x ♯ P"
shows "<νx>(P ∥ Q) ∼⇩e P ∥ <νx>Q"
proof -
from assms have "<νx>(P ∥ Q) ∼⇩l P ∥ <νx>Q" by(rule Strong_Late_Bisim_SC.scopeExtPar)
thus ?thesis by(rule lateEarlyBisim)
qed
lemma scopeExtPar':
fixes P :: pi
and Q :: pi
and x :: name
assumes xFreshQ: "x ♯ Q"
shows "<νx>(P ∥ Q) ∼⇩e (<νx>P) ∥ Q"
proof -
from assms have "<νx>(P ∥ Q) ∼⇩l (<νx>P) ∥ Q" by(rule Strong_Late_Bisim_SC.scopeExtPar')
thus ?thesis by(rule lateEarlyBisim)
qed
lemma parAssoc:
fixes P :: pi
and Q :: pi
and R :: pi
shows "(P ∥ Q) ∥ R ∼⇩e P ∥ (Q ∥ R)"
proof -
have "(P ∥ Q) ∥ R ∼⇩l P ∥ (Q ∥ R)" by(rule Strong_Late_Bisim_SC.parAssoc)
thus ?thesis by(rule lateEarlyBisim)
qed
lemma freshRes:
fixes P :: pi
and a :: name
assumes aFreshP: "a ♯ P"
shows "<νa>P ∼⇩e P"
proof -
from aFreshP have "<νa>P ∼⇩l P" by(rule Strong_Late_Bisim_SC.scopeFresh)
thus ?thesis by(rule lateEarlyBisim)
qed
lemma scopeExtSum:
fixes P :: pi
and Q :: pi
and x :: name
assumes "x ♯ P"
shows "<νx>(P ⊕ Q) ∼⇩e P ⊕ <νx>Q"
proof -
from ‹x ♯ P› have "<νx>(P ⊕ Q) ∼⇩l P ⊕ <νx>Q" by(rule Strong_Late_Bisim_SC.scopeExtSum)
thus ?thesis by(rule lateEarlyBisim)
qed
lemma bangSC:
fixes P
shows "!P ∼⇩e P ∥ !P"
proof -
have "!P ∼⇩l P ∥ !P" by(rule Strong_Late_Bisim_SC.bangSC)
thus ?thesis by(rule lateEarlyBisim)
qed
end
Theory Weak_Early_Bisim_SC
theory Weak_Early_Bisim_SC
imports Weak_Early_Bisim Strong_Early_Bisim_SC
begin
lemma weakBisimStructCong:
fixes P :: pi
and Q :: pi
assumes "P ≡⇩s Q"
shows "P ≈ Q"
using assms
by(metis earlyBisimStructCong strongBisimWeakBisim)
lemma matchId:
fixes a :: name
and P :: pi
shows "[a⌢a]P ≈ P"
proof -
have "[a⌢a]P ∼⇩e P" by(rule Strong_Early_Bisim_SC.matchId)
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma mismatchId:
fixes a :: name
and b :: name
and P :: pi
assumes "a ≠ b"
shows "[a≠b]P ≈ P"
proof -
from ‹a ≠ b› have "[a≠b]P ∼⇩e P" by(rule Strong_Early_Bisim_SC.mismatchId)
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma mismatchNil:
fixes a :: name
and P :: pi
shows "[a≠a]P ≈ 𝟬"
proof -
have "[a≠a]P ∼⇩e 𝟬" by(rule Strong_Early_Bisim_SC.mismatchNil)
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma resComm:
fixes P :: pi
shows "<νa><νb>P ≈ <νb><νa>P"
proof -
have "<νa><νb>P ∼⇩e <νb><νa>P" by(rule Strong_Early_Bisim_SC.resComm)
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma sumSym:
fixes P :: pi
and Q :: pi
shows "P ⊕ Q ≈ Q ⊕ P"
proof -
have "P ⊕ Q ∼⇩e Q ⊕ P" by(rule Strong_Early_Bisim_SC.sumSym)
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma sumAssoc:
fixes P :: pi
and Q :: pi
and R :: pi
shows "(P ⊕ Q) ⊕ R ≈ P ⊕ (Q ⊕ R)"
proof -
have "(P ⊕ Q) ⊕ R ∼⇩e P ⊕ (Q ⊕ R)" by(rule Strong_Early_Bisim_SC.sumAssoc)
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma sumZero:
fixes P :: pi
shows "P ⊕ 𝟬 ≈ P"
proof -
have "P ⊕ 𝟬 ∼⇩e P" by(rule Strong_Early_Bisim_SC.sumZero)
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma parZero:
fixes P :: pi
shows "P ∥ 𝟬 ≈ P"
proof -
have "P ∥ 𝟬 ∼⇩e P" by(rule Strong_Early_Bisim_SC.parZero)
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma parSym:
fixes P :: pi
and Q :: pi
shows "P ∥ Q ≈ Q ∥ P"
proof -
have "P ∥ Q ∼⇩e Q ∥ P" by(rule Strong_Early_Bisim_SC.parSym)
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma scopeExtPar:
fixes P :: pi
and Q :: pi
and x :: name
assumes "x ♯ P"
shows "<νx>(P ∥ Q) ≈ P ∥ <νx>Q"
proof -
from ‹x ♯ P› have "<νx>(P ∥ Q) ∼⇩e P ∥ <νx>Q" by(rule Strong_Early_Bisim_SC.scopeExtPar)
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma scopeExtPar':
fixes P :: pi
and Q :: pi
and x :: name
assumes "x ♯ Q"
shows "<νx>(P ∥ Q) ≈ (<νx>P) ∥ Q"
proof -
from ‹x ♯ Q› have "<νx>(P ∥ Q) ∼⇩e (<νx>P) ∥ Q" by(rule Strong_Early_Bisim_SC.scopeExtPar')
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma parAssoc:
fixes P :: pi
and Q :: pi
and R :: pi
shows "(P ∥ Q) ∥ R ≈ P ∥ (Q ∥ R)"
proof -
have "(P ∥ Q) ∥ R ∼⇩e P ∥ (Q ∥ R)" by(rule Strong_Early_Bisim_SC.parAssoc)
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma freshRes:
fixes P :: pi
and a :: name
assumes "a ♯ P"
shows "<νa>P ≈ P"
proof -
from ‹a ♯ P› have "<νa>P ∼⇩e P" by(rule Strong_Early_Bisim_SC.freshRes)
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma scopeExtSum:
fixes P :: pi
and Q :: pi
and x :: name
assumes "x ♯ P"
shows "<νx>(P ⊕ Q) ≈ P ⊕ <νx>Q"
proof -
from ‹x ♯ P› have "<νx>(P ⊕ Q) ∼⇩e P ⊕ <νx>Q" by(rule Strong_Early_Bisim_SC.scopeExtSum)
thus ?thesis by(rule strongBisimWeakBisim)
qed
lemma bangSC:
fixes P
shows "!P ≈ P ∥ !P"
proof -
have "!P ∼⇩e P ∥ !P" by(rule Strong_Early_Bisim_SC.bangSC)
thus ?thesis by(rule strongBisimWeakBisim)
qed
end
Theory Weak_Early_Bisim_Pres
theory Weak_Early_Bisim_Pres
imports Strong_Early_Bisim_Pres Weak_Early_Sim_Pres Weak_Early_Bisim_SC Weak_Early_Bisim
begin
lemma tauPres:
fixes P :: pi
and Q :: pi
assumes "P ≈ Q"
shows "τ.(P) ≈ τ.(Q)"
proof -
let ?X = "{(τ.(P), τ.(Q)) | P Q. P ≈ Q}"
from ‹P ≈ Q› have "(τ.(P), τ.(Q)) ∈ ?X" by auto
thus ?thesis
proof(coinduct rule: weakBisimCoinduct)
case(cSim P Q)
thus ?case
by(force intro: Weak_Early_Sim_Pres.tauPres)
next
case(cSym P Q)
thus ?case by(force dest: Weak_Early_Bisim.symetric simp add: pi.inject)
qed
qed
lemma outputPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
assumes "P ≈ Q"
shows "a{b}.P ≈ a{b}.Q"
proof -
let ?X = "{(a{b}.(P), a{b}.(Q)) | P Q a b. P ≈ Q}"
from ‹P ≈ Q› have "(a{b}.(P), a{b}.(Q)) ∈ ?X" by auto
thus ?thesis
proof(coinduct rule: weakBisimCoinduct)
case(cSim P Q)
thus ?case
by(force intro: Weak_Early_Sim_Pres.outputPres)
next
case(cSym P Q)
thus ?case by(force dest: Weak_Early_Bisim.symetric simp add: pi.inject)
qed
qed
lemma inputPres:
fixes P :: pi
and Q :: pi
and a :: name
and x :: name
assumes PSimQ: "∀y. P[x::=y] ≈ Q[x::=y]"
shows "a<x>.P ≈ a<x>.Q"
proof -
let ?X = "{(a<x>.P, a<x>.Q) | a x P Q. ∀y. P[x::=y] ≈ Q[x::=y]}"
{
fix axP axQ p
assume "(axP, axQ) ∈ ?X"
then obtain a x P Q where A: "∀y. P[x::=y] ≈ Q[x::=y]" and B: "axP = a<x>.P" and C: "axQ = a<x>.Q"
by auto
have "⋀y. ((p::name prm) ∙ P)[(p ∙ x)::=y] ≈ (p ∙ Q)[(p ∙ x)::=y]"
proof -
fix y
from A have "P[x::=(rev p ∙ y)] ≈ Q[x::=(rev p ∙ y)]"
by blast
hence "(p ∙ (P[x::=(rev p ∙ y)])) ≈ p ∙ (Q[x::=(rev p ∙ y)])"
by(rule eqvts)
thus "(p ∙ P)[(p ∙ x)::=y] ≈ (p ∙ Q)[(p ∙ x)::=y]"
by(simp add: eqvts pt_pi_rev[OF pt_name_inst, OF at_name_inst])
qed
hence "((p::name prm) ∙ axP, p ∙ axQ) ∈ ?X" using B C
by auto
}
hence "eqvt ?X" by(simp add: eqvt_def)
from PSimQ have "(a<x>.P, a<x>.Q) ∈ ?X" by auto
thus ?thesis
proof(coinduct rule: weakBisimCoinduct)
case(cSim P Q)
thus ?case using ‹eqvt ?X›
by(force intro: Weak_Early_Sim_Pres.inputPres)
next
case(cSym P Q)
thus ?case
by(blast dest: weakBisimE)
qed
qed
lemma resPres:
fixes P :: pi
and Q :: pi
and x :: name
assumes "P ≈ Q"
shows "<νx>P ≈ <νx>Q"
proof -
let ?X = "{(<νx>P, <νx>Q) | x P Q. P ≈ Q}"
from ‹P ≈ Q› have "(<νx>P, <νx>Q) ∈ ?X" by blast
thus ?thesis
proof(coinduct rule: weakBisimCoinduct)
case(cSim xP xQ)
{
fix P Q x
assume "P ≈ Q"
hence "P ↝<weakBisim> Q" by(rule weakBisimE)
moreover have "⋀P Q x. P ≈ Q ⟹ (<νx>P, <νx>Q) ∈ ?X ∪ weakBisim" by blast
moreover have "weakBisim ⊆ ?X ∪ weakBisim" by blast
moreover have "eqvt weakBisim" by simp
moreover have "eqvt (?X ∪ weakBisim)"
by(auto simp add: eqvt_def dest: Weak_Early_Bisim.eqvtI)+
ultimately have "<νx>P ↝<(?X ∪ weakBisim)> <νx>Q"
by(rule Weak_Early_Sim_Pres.resPres)
}
with ‹(xP, xQ) ∈ ?X› show ?case by blast
next
case(cSym xP xQ)
thus ?case by(blast dest: Weak_Early_Bisim.symetric)
qed
qed
lemma matchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
assumes "P ≈ Q"
shows "[a⌢b]P ≈ [a⌢b]Q"
proof -
let ?X = "{([a⌢b]P, [a⌢b]Q) | a b P Q. P ≈ Q}"
from ‹P ≈ Q› have "([a⌢b]P, [a⌢b]Q) ∈ ?X" by blast
thus ?thesis
proof(coinduct rule: weakBisimCoinduct)
case(cSim abP abQ)
{
fix P Q a b
assume "P ≈ Q"
hence "P ↝<weakBisim> Q" by(rule weakBisimE)
moreover have "weakBisim ⊆ (?X ∪ weakBisim)" by blast
moreover have "⋀P Q a. P ≈ Q ⟹ [a⌢a]P ≈ Q"
by (metis (full_types) strongBisimWeakBisim Strong_Early_Bisim_SC.matchId Weak_Early_Bisim.transitive)
ultimately have"[a⌢b]P ↝<(?X ∪ weakBisim)> [a⌢b]Q"
by(rule Weak_Early_Sim_Pres.matchPres)
}
with ‹(abP, abQ) ∈ ?X› show ?case by blast
next
case(cSym abP abQ)
thus ?case by(blast dest: Weak_Early_Bisim.symetric)
qed
qed
lemma mismatchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
assumes "P ≈ Q"
shows "[a≠b]P ≈ [a≠b]Q"
proof -
let ?X = "{([a≠b]P, [a≠b]Q)| a b P Q. P ≈ Q}"
from ‹P ≈ Q› have "([a≠b]P, [a≠b]Q) ∈ ?X" by blast
thus ?thesis
proof(coinduct rule: weakBisimCoinduct)
case(cSim abP abQ)
{
fix P Q a b
assume "P ≈ Q"
hence "P ↝<weakBisim> Q" by(rule weakBisimE)
moreover have "weakBisim ⊆ (?X ∪ weakBisim)" by blast
moreover have "⋀P Q a b. ⟦P ≈ Q; a ≠ b⟧ ⟹ [a≠b]P ≈ Q"
by (metis (full_types) strongBisimWeakBisim Strong_Early_Bisim_SC.mismatchId Weak_Early_Bisim.transitive)
ultimately have "[a≠b]P ↝<(?X ∪ weakBisim)> [a≠b]Q"
by(rule Weak_Early_Sim_Pres.mismatchPres)
}
with ‹(abP, abQ) ∈ ?X› show ?case by blast
next
case(cSym abP abQ)
thus ?case by(blast dest: Weak_Early_Bisim.symetric)
qed
qed
lemma parPres:
fixes P :: pi
and Q :: pi
and R :: pi
assumes "P ≈ Q"
shows "P ∥ R ≈ Q ∥ R"
proof -
let ?X = "{(resChain lst (P ∥ R), resChain lst (Q ∥ R)) | lst P R Q. P ≈ Q}"
have BC: "⋀P Q. P ∥ Q = resChain [] (P ∥ Q)" by auto
from ‹P ≈ Q› have "(P ∥ R, Q ∥ R) ∈ ?X" by(blast intro: BC)
thus ?thesis
proof(coinduct rule: weakBisimCoinduct)
case(cSym PR QR)
{
fix P Q R lst
assume "P ≈ Q"
moreover hence "P ↝<weakBisim> Q" by(rule weakBisimE)
moreover have "⋀P Q R. P ≈ Q ⟹ (P ∥ R, Q ∥ R) ∈ ?X" using BC
by blast
moreover {
fix PR QR x
assume "(PR, QR) ∈ ?X"
then obtain lst P Q R where "P ≈ Q" and A: "PR = resChain lst (P ∥ R)" and B: "QR = resChain lst (Q ∥ R)"
by auto
from A have "<νx>PR = resChain (x#lst) (P ∥ R)" by auto
moreover from B have "<νx>QR = resChain (x#lst) (Q ∥ R)" by auto
ultimately have "(<νx>PR, <νx>QR) ∈ ?X" using ‹P ≈ Q›
by blast
}
note Res = this
ultimately have "P ∥ R ↝<?X> Q ∥ R"
by(rule_tac Weak_Early_Sim_Pres.parPres)
moreover have "eqvt ?X"
by(auto simp add: eqvt_def) (blast intro: eqvts)
ultimately have "resChain lst (P ∥ R) ↝<?X> resChain lst (Q ∥ R)" using Res
by(rule_tac Weak_Early_Sim_Pres.resChainI)
hence "resChain lst (P ∥ R) ↝<(?X ∪ weakBisim)> resChain lst (Q ∥ R)"
by(force intro: Weak_Early_Sim.monotonic)
}
with ‹(PR, QR) ∈ ?X› show "PR ↝<(?X ∪ weakBisim)> QR"
by blast
next
case(cSym PR QR)
thus ?case by(blast dest: Weak_Early_Bisim.symetric)
qed
qed
lemma bangPres:
fixes P :: pi
and Q :: pi
assumes PBisimQ: "P ≈ Q"
shows "!P ≈ !Q"
proof -
let ?X = "(bangRel weakBisim)"
let ?Y = "Strong_Early_Bisim.bisim O (bangRel weakBisim) O Strong_Early_Bisim.bisim"
from Weak_Early_Bisim.eqvt Strong_Early_Bisim.eqvt have eqvtY: "eqvt ?Y" by(blast intro: eqvtBangRel)
have XsubY: "?X ⊆ ?Y" by(auto intro: Strong_Early_Bisim.reflexive)
have RelStay: "⋀P Q. (P ∥ !P, Q) ∈ ?Y ⟹ (!P, Q) ∈ ?Y"
proof(auto)
fix P Q R T
assume PBisimQ: "P ∥ !P ∼⇩e Q"
and QBRR: "(Q, R) ∈ bangRel weakBisim"
and RBisimT: "R ∼⇩e T"
have "!P ∼⇩e Q"
proof -
have "!P ∼⇩e P ∥ !P" by(rule Strong_Early_Bisim_SC.bangSC)
thus ?thesis using PBisimQ by(rule Strong_Early_Bisim.transitive)
qed
with QBRR RBisimT show "(!P, T) ∈ ?Y" by blast
qed
have ParCompose: "⋀P Q R T. ⟦P ≈ Q; (R, T) ∈ ?Y⟧ ⟹ (P ∥ R, Q ∥ T) ∈ ?Y"
proof -
fix P Q R T
assume PBisimQ: "P ≈ Q"
and RYT: "(R, T) ∈ ?Y"
thus "(P ∥ R, Q ∥ T) ∈ ?Y"
proof(auto)
fix T' R'
assume T'BisimT: "T' ∼⇩e T" and RBisimR': "R ∼⇩e R'"
and R'BRT': "(R', T') ∈ bangRel weakBisim"
have "P ∥ R ∼⇩e P ∥ R'"
proof -
from RBisimR' have "R ∥ P ∼⇩e R' ∥ P" by(rule Strong_Early_Bisim_Pres.parPres)
moreover have "P ∥ R ∼⇩e R ∥ P" and "R' ∥ P ∼⇩e P ∥ R'" by(rule Strong_Early_Bisim_SC.parSym)+
ultimately show ?thesis by(blast intro: Strong_Early_Bisim.transitive)
qed
moreover from PBisimQ R'BRT' have "(P ∥ R', Q ∥ T') ∈ bangRel weakBisim" by(rule BRPar)
moreover have "Q ∥ T' ∼⇩e Q ∥ T"
proof -
from T'BisimT have "T' ∥ Q ∼⇩e T ∥ Q" by(rule Strong_Early_Bisim_Pres.parPres)
moreover have "Q ∥ T' ∼⇩e T' ∥ Q" and "T ∥ Q ∼⇩e Q ∥ T" by(rule Strong_Early_Bisim_SC.parSym)+
ultimately show ?thesis by(blast intro: Strong_Early_Bisim.transitive)
qed
ultimately show ?thesis by blast
qed
qed
have ResCong: "⋀P Q x. (P, Q) ∈ ?Y ⟹ (<νx>P, <νx>Q) ∈ ?Y"
by(auto intro: BRRes Strong_Early_Bisim_Pres.resPres transitive)
have Sim: "⋀P Q. (P, Q) ∈ ?X ⟹ P ↝<?Y> Q"
proof -
fix P Q
assume "(P, Q) ∈ ?X"
thus "P ↝<?Y> Q"
proof(induct)
case(BRBang P Q)
have "P ≈ Q" by fact
moreover hence "P ↝<weakBisim> Q" by(blast dest: weakBisimE)
moreover have "⋀P Q. P ≈ Q ⟹ P ↝<weakBisim> Q" by(blast dest: weakBisimE)
moreover from Strong_Early_Bisim.eqvt Weak_Early_Bisim.eqvt have "eqvt ?Y" by(blast intro: eqvtBangRel)
ultimately show "!P ↝<?Y> !Q" using ParCompose ResCong RelStay XsubY
by(rule_tac Weak_Early_Sim_Pres.bangPres, simp_all)
next
case(BRPar P Q R T)
have PBiSimQ: "P ≈ Q" by fact
moreover have RBangRelT: "(R, T) ∈ ?X" by fact
have RSimT: "R ↝<?Y> T" by fact
moreover from PBiSimQ have "P ↝<weakBisim> Q" by(blast dest: weakBisimE)
moreover from RBangRelT have "(R, T) ∈ ?Y" by(blast intro: Strong_Early_Bisim.reflexive)
ultimately show "P ∥ R ↝<?Y> Q ∥ T" using ParCompose ResCong eqvt eqvtY
by(rule_tac Weak_Early_Sim_Pres.parCompose)
next
case(BRRes P Q x)
have "P ↝<?Y> Q" by fact
thus "<νx>P ↝<?Y> <νx>Q" using ResCong eqvtY XsubY
by(rule_tac Weak_Early_Sim_Pres.resPres, simp_all)
qed
qed
from PBisimQ have "(!P, !Q) ∈ ?X" by(rule BRBang)
moreover from Weak_Early_Bisim.eqvt have "eqvt (bangRel weakBisim)" by(rule eqvtBangRel)
ultimately show ?thesis
apply(coinduct rule: Weak_Early_Bisim.transitive_coinduct_weak)
apply(blast intro: Sim)
by(blast dest: bangRelSymetric Weak_Early_Bisim.symetric intro: Strong_Early_Bisim.reflexive)
qed
lemma bangRelSubWeakBisim:
shows "bangRel weakBisim ⊆ weakBisim"
proof(auto)
fix a b
assume "(a, b) ∈ bangRel weakBisim"
thus "a ≈ b"
proof(induct)
fix P Q
assume "P ≈ Q"
thus "!P ≈ !Q" by(rule bangPres)
next
fix P Q R T
assume "R ≈ T" and "P ≈ Q"
thus "R ∥ P ≈ T ∥ Q" by(metis parPres parSym Weak_Early_Bisim.transitive)
next
fix P Q
fix a::name
assume "P ≈ Q"
thus "<νa>P ≈ <νa>Q" by(rule resPres)
qed
qed
end
Theory Weak_Early_Cong_Pres
theory Weak_Early_Cong_Pres
imports Weak_Early_Cong Weak_Early_Step_Sim_Pres Weak_Early_Bisim_Pres
begin
lemma tauPres:
fixes P :: pi
and Q :: pi
assumes "P ≃ Q"
shows "τ.(P) ≃ τ.(Q)"
proof -
from assms have "P ≈ Q" by(rule congruenceWeakBisim)
thus ?thesis by(force intro: Weak_Early_Step_Sim_Pres.tauPres simp add: weakCongruence_def dest: weakBisimE(2))
qed
lemma outputPres:
fixes P :: pi
and Q :: pi
assumes "P ≃ Q"
shows "a{b}.P ≃ a{b}.Q"
proof -
from assms have "P ≈ Q" by(rule congruenceWeakBisim)
thus ?thesis by(force intro: Weak_Early_Step_Sim_Pres.outputPres simp add: weakCongruence_def dest: weakBisimE(2))
qed
lemma matchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
assumes "P ≃ Q"
shows "[a⌢b]P ≃ [a⌢b]Q"
using assms
by(auto simp add: weakCongruence_def intro: Weak_Early_Step_Sim_Pres.matchPres)
lemma mismatchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
assumes "P ≃ Q"
shows "[a≠b]P ≃ [a≠b]Q"
using assms
by(auto simp add: weakCongruence_def intro: Weak_Early_Step_Sim_Pres.mismatchPres)
lemma sumPres:
fixes P :: pi
and Q :: pi
and R :: pi
assumes "P ≃ Q"
shows "P ⊕ R ≃ Q ⊕ R"
using assms
by(auto simp add: weakCongruence_def intro: Weak_Early_Step_Sim_Pres.sumPres Weak_Early_Bisim.reflexive)
lemma parPres:
fixes P :: pi
and Q :: pi
and R :: pi
assumes "P ≃ Q"
shows "P ∥ R ≃ Q ∥ R"
proof -
have "⋀P Q R. ⟦P ↝«weakBisim» Q; P ≈ Q⟧ ⟹ P ∥ R ↝«weakBisim» Q ∥ R"
proof -
fix P Q R
assume "P ↝«weakBisim» Q" and "P ≈ Q"
thus "P ∥ R ↝«weakBisim» Q ∥ R"
using Weak_Early_Bisim_Pres.parPres Weak_Early_Bisim_Pres.resPres Weak_Early_Bisim.reflexive Weak_Early_Bisim.eqvt
by(blast intro: Weak_Early_Step_Sim_Pres.parPres)
qed
moreover from assms have "P ≈ Q" by(rule congruenceWeakBisim)
ultimately show ?thesis using assms
by(auto simp add: weakCongruence_def dest: weakBisimE)
qed
lemma resPres:
fixes P :: pi
and Q :: pi
and x :: name
assumes PeqQ: "P ≃ Q"
shows "<νx>P ≃ <νx>Q"
proof -
have "⋀P Q x. P ↝«weakBisim» Q ⟹ <νx>P ↝«weakBisim» <νx>Q"
proof -
fix P Q x
assume "P ↝«weakBisim» Q"
with Weak_Early_Bisim.eqvt Weak_Early_Bisim_Pres.resPres show "<νx>P ↝«weakBisim» <νx>Q"
by(blast intro: Weak_Early_Step_Sim_Pres.resPres)
qed
with assms show ?thesis by(simp add: weakCongruence_def)
qed
lemma bangPres:
fixes P :: pi
and Q :: pi
assumes "P ≃ Q"
shows "!P ≃ !Q"
using assms
proof(induct rule: weakCongISym2)
case(cSim P Q)
let ?X = "{(P, Q) | P Q. P ≃ Q}"
from ‹P ≃ Q› have "(P, Q) ∈ ?X" by auto
moreover have "⋀P Q. (P, Q) ∈ ?X ⟹ P ↝«weakBisim» Q" by(auto simp add: weakCongruence_def)
moreover from congruenceWeakBisim have "?X ⊆ weakBisim" by auto
ultimately have "!P ↝«bangRel weakBisim» !Q" using Weak_Early_Bisim.eqvt
by(rule Weak_Early_Step_Sim_Pres.bangPres)
moreover have "bangRel weakBisim ⊆ weakBisim" by(rule bangRelSubWeakBisim)
ultimately show "!P ↝«weakBisim» !Q"
by(rule Weak_Early_Step_Sim.monotonic)
qed
end
Theory Weak_Early_Cong_Subst_Pres
theory Weak_Early_Cong_Subst_Pres
imports Weak_Early_Cong_Subst Weak_Early_Cong_Pres
begin
lemma weakCongStructCong:
fixes P :: pi
and Q :: pi
assumes "P ≡⇩s Q"
shows "P ≃⇧s Q"
using assms
by(metis earlyCongStructCong strongEqWeakCong)
lemma tauPres:
fixes P :: pi
and Q :: pi
assumes "P ≃⇧s Q"
shows "τ.(P) ≃⇧s τ.(Q)"
using assms
by(auto simp add: weakCongruenceSubst_def intro: Weak_Early_Cong_Pres.tauPres)
lemma inputPres:
fixes P :: pi
and Q :: pi
and a :: name
and x :: name
assumes PeqQ: "P ≃⇧s Q"
shows "a<x>.P ≃⇧s a<x>.Q"
proof(auto simp add: weakCongruenceSubst_def)
fix s::"(name × name) list"
from congruenceWeakBisim have Input: "⋀P Q a x s. ⟦P[<s>] ≃⇧s Q[<s>]; x ♯ s⟧ ⟹ (a<x>.P)[<s>] ≃ (a<x>.Q)[<s>]"
apply(auto simp add: weakCongruenceSubst_def weakCongruence_def)
apply(rule Weak_Early_Step_Sim_Pres.inputPres, auto)
apply(erule_tac x="[(x, y)]" in allE, auto)
apply(rule Weak_Early_Step_Sim_Pres.inputPres, auto)
by(erule_tac x="[(x, y)]" in allE, auto)
then obtain c::name where cFreshP: "c ♯ P" and cFreshQ: "c ♯ Q" and cFreshs: "c ♯ s"
by(force intro: name_exists_fresh[of "(P, Q, s)"])
from PeqQ have "P[<([(x, c)] ∙ s)>] ≃⇧s Q[<([(x, c)] ∙ s)>]" by(rule partUnfold)
hence "([(x, c)] ∙ P[<([(x, c)] ∙ s)>]) ≃⇧s ([(x, c)] ∙ Q[<([(x, c)] ∙ s)>])" by(rule Weak_Early_Cong_Subst.eqvtI)
hence "([(x, c)] ∙ P)[<s>] ≃⇧s ([(x, c)] ∙ Q)[<s>]" by simp
hence "(a<c>.([(x, c)] ∙ P))[<s>] ≃ (a<c>.([(x, c)] ∙ Q))[<s>]" using cFreshs by(rule Input)
moreover from cFreshP cFreshQ have "a<x>.P = a<c>.([(x, c)] ∙ P)" and "a<x>.Q = a<c>.([(x, c)] ∙ Q)"
by(simp add: Agent.alphaInput)+
ultimately show "(a<x>.P)[<s>] ≃ (a<x>.Q)[<s>]" by simp
qed
lemma outputPres:
fixes P :: pi
and Q :: pi
assumes "P ≃⇧s Q"
shows "a{b}.P ≃⇧s a{b}.Q"
using assms
by(auto simp add: weakCongruenceSubst_def intro: Weak_Early_Cong_Pres.outputPres)
lemma matchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
assumes "P ≃⇧s Q"
shows "[a⌢b]P ≃⇧s [a⌢b]Q"
using assms
by(auto simp add: weakCongruenceSubst_def intro: Weak_Early_Cong_Pres.matchPres)
lemma mismatchPres:
fixes P :: pi
and Q :: pi
and a :: name
and b :: name
assumes "P ≃⇧s Q"
shows "[a≠b]P ≃⇧s [a≠b]Q"
using assms
by(auto simp add: weakCongruenceSubst_def intro: Weak_Early_Cong_Pres.mismatchPres)
lemma sumPres:
fixes P :: pi
and Q :: pi
and R :: pi
assumes "P ≃⇧s Q"
shows "P ⊕ R ≃⇧s Q ⊕ R"
using assms
by(auto simp add: weakCongruenceSubst_def intro: Weak_Early_Cong_Pres.sumPres)
lemma parPres:
fixes P :: pi
and Q :: pi
and R :: pi
assumes "P ≃⇧s Q"
shows "P ∥ R ≃⇧s Q ∥ R"
using assms
by(auto simp add: weakCongruenceSubst_def intro: Weak_Early_Cong_Pres.parPres)
lemma resPres:
fixes P :: pi
and Q :: pi
and x :: name
assumes PeqQ: "P ≃⇧s Q"
shows "<νx>P ≃⇧s <νx>Q"
proof(auto simp add: weakCongruenceSubst_def)
fix s::"(name × name) list"
have Goal: "⋀P Q x s. ⟦P[<s>] ↝«weakBisim» Q[<s>]; x ♯ s⟧ ⟹ (<νx>P)[<s>] ↝«weakBisim» (<νx>Q)[<s>]"
by(force intro: Weak_Early_Step_Sim_Pres.resPres Weak_Early_Bisim_Pres.resPres Weak_Early_Bisim.eqvt)
then obtain c::name where cFreshP: "c ♯ P" and cFreshQ: "c ♯ Q" and cFreshs: "c ♯ s"
by(force intro: name_exists_fresh[of "(P, Q, s)"])
from PeqQ have "P[<([(x, c)] ∙ s)>] ↝«weakBisim» Q[<([(x, c)] ∙ s)>]" and
"Q[<([(x, c)] ∙ s)>] ↝«weakBisim» P[<([(x, c)] ∙ s)>]"
by(force simp add: weakCongruenceSubst_def weakCongruence_def)+
hence "([(x, c)] ∙ (P[<([(x, c)] ∙ s)>])) ↝«weakBisim» ([(x, c)] ∙ (Q[<([(x, c)] ∙ s)>]))" and
"([(x, c)] ∙ (Q[<([(x, c)] ∙ s)>])) ↝«weakBisim» ([(x, c)] ∙ (P[<([(x, c)] ∙ s)>]))"
by(blast intro: Weak_Early_Step_Sim.eqvtI Weak_Early_Bisim.eqvt)+
hence "([(x, c)] ∙ P)[<s>] ↝«weakBisim» ([(x, c)] ∙ Q)[<s>]" and
"([(x, c)] ∙ Q)[<s>] ↝«weakBisim» ([(x, c)] ∙ P)[<s>]" by simp+
with cFreshs have "(<νc>([(x, c)] ∙ P))[<s>] ↝«weakBisim» (<νc>([(x, c)] ∙ Q))[<s>]" and
"(<νc>([(x, c)] ∙ Q))[<s>] ↝«weakBisim» (<νc>([(x, c)] ∙ P))[<s>]"
by(blast intro: Goal)+
moreover from cFreshP cFreshQ have "<νx>P = <νc>([(x, c)] ∙ P)" and "<νx>Q = <νc>([(x, c)] ∙ Q)"
by(simp add: alphaRes)+
ultimately show "(<νx>P)[<s>] ≃ (<νx>Q)[<s>]"
by(simp add: weakCongruence_def)
qed
lemma bangPres:
fixes P :: pi
and Q :: pi
assumes "P ≃⇧s Q"
shows "!P ≃⇧s !Q"
using assms
by(auto simp add: weakCongruenceSubst_def intro: Weak_Early_Cong_Pres.bangPres)
end
Theory Strong_Late_Expansion_Law
theory Strong_Late_Expansion_Law
imports Strong_Late_Bisim_SC
begin
nominal_primrec summands :: "pi ⇒ pi set" where
"summands 𝟬 = {}"
| "summands (τ.(P)) = {τ.(P)}"
| "x ♯ a ⟹ summands (a<x>.P) = {a<x>.P}"
| "summands (a{b}.P) = {a{b}.P}"
| "summands ([a⌢b]P) = {}"
| "summands ([a≠b]P) = {}"
| "summands (P ⊕ Q) = (summands P) ∪ (summands Q)"
| "summands (P ∥ Q) = {}"
| "summands (<νx>P) = (if (∃a P'. a ≠ x ∧ P = a{x}.P') then ({<νx>P}) else {})"
| "summands (!P) = {}"
apply(auto simp add: fresh_singleton name_fresh_abs fresh_set_empty fresh_singleton pi.fresh)
apply(finite_guess)+
by(fresh_guess)+
lemma summandsInput[simp]:
fixes a :: name
and x :: name
and P :: pi
shows "summands (a<x>.P) = {a<x>.P}"
proof -
obtain y where yineqa: "y ≠ a" and yFreshP: "y ♯ P"
by(force intro: name_exists_fresh[of "(a, P)"] simp add: fresh_prod)
from yFreshP have "a<x>.P = a<y>.([(x, y)] ∙ P)" by(simp add: alphaInput)
with yineqa show ?thesis by simp
qed
lemma finiteSummands:
fixes P :: pi
shows "finite(summands P)"
by(induct P rule: pi.induct) auto
lemma boundSummandDest[dest]:
fixes x :: name
and y :: name
and P' :: pi
and P :: pi
assumes "<νx>x{y}.P' ∈ summands P"
shows False
using assms
by(induct P rule: pi.induct, auto simp add: if_split pi.inject name_abs_eq name_calc)
lemma summandFresh:
fixes P :: pi
and Q :: pi
and x :: name
assumes "P ∈ summands Q"
and "x ♯ Q"
shows "x ♯ P"
using assms
by(nominal_induct Q avoiding: P rule: pi.strong_induct, auto simp add: if_split)
nominal_primrec hnf :: "pi ⇒ bool" where
"hnf 𝟬 = True"
| "hnf (τ.(P)) = True"
| "x ♯ a ⟹ hnf (a<x>.P) = True"
| "hnf (a{b}.P) = True"
| "hnf ([a⌢b]P) = False"
| "hnf ([a≠b]P) = False"
| "hnf (P ⊕ Q) = ((hnf P) ∧ (hnf Q) ∧ P ≠ 𝟬 ∧ Q ≠ 𝟬)"
| "hnf (P ∥ Q) = False"
| "hnf (<νx>P) = (∃a P'. a ≠ x ∧ P = a{x}.P')"
| "hnf (!P) = False"
apply(auto simp add: fresh_bool)
apply(finite_guess)+
by(fresh_guess)+
lemma hnfInput[simp]:
fixes a :: name
and x :: name
and P :: pi
shows "hnf (a<x>.P)"
proof -
obtain y where yineqa: "y ≠ a" and yFreshP: "y ♯ P"
by(force intro: name_exists_fresh[of "(a, P)"] simp add: fresh_prod)
from yFreshP have "a<x>.P = a<y>.([(x, y)] ∙ P)" by(simp add: alphaInput)
with yineqa show ?thesis by simp
qed
lemma summandTransition:
fixes P :: pi
and a :: name
and x :: name
and b :: name
and P' :: pi
assumes "hnf P"
shows "P ⟼τ ≺ P' = (τ.(P') ∈ summands P)"
and "P ⟼a<x> ≺ P' = (a<x>.P' ∈ summands P)"
and "P ⟼a[b] ≺ P' = (a{b}.P' ∈ summands P)"
and "a ≠ x ⟹ P ⟼a<νx> ≺ P' = (<νx>a{x}.P' ∈ summands P)"
proof -
from assms show "P ⟼τ ≺ P' = (τ.(P') ∈ summands P)"
proof(induct P rule: pi.induct)
case PiNil
show ?case by auto
next
case(Output a b P)
show ?case by auto
next
case(Tau P)
have "τ.(P) ⟼τ ≺ P' ⟹ τ.(P') ∈ summands (τ.(P))"
by(auto elim: tauCases simp add: pi.inject residual.inject)
moreover have "τ.(P') ∈ summands (τ.(P)) ⟹ τ.(P) ⟼τ ≺ P'"
by(auto simp add: pi.inject intro: transitions.Tau)
ultimately show ?case by blast
next
case(Input a x P)
show ?case by auto
next
case(Match a b P)
have "hnf ([a⌢b]P)" by fact
hence False by simp
thus ?case by simp
next
case(Mismatch a b P)
have "hnf ([a≠b]P)" by fact
hence False by simp
thus ?case by simp
next
case(Sum P Q)
have "hnf (P ⊕ Q)" by fact
hence Phnf: "hnf P" and Qhnf: "hnf Q" by simp+
have IHP: "P ⟼τ ≺ P' = (τ.(P') ∈ summands P)"
proof -
have "hnf P ⟹ P ⟼τ ≺ P' = (τ.(P') ∈ summands P)" by fact
with Phnf show ?thesis by simp
qed
have IHQ: "Q ⟼τ ≺ P' = (τ.(P') ∈ summands Q)"
proof -
have "hnf Q ⟹ Q ⟼τ ≺ P' = (τ.(P') ∈ summands Q)" by fact
with Qhnf show ?thesis by simp
qed
from IHP IHQ have "P ⊕ Q ⟼τ ≺ P' ⟹ τ.(P') ∈ summands (P ⊕ Q)"
by(erule_tac sumCases, auto)
moreover from IHP IHQ have "τ.(P') ∈ summands (P ⊕ Q) ⟹ P ⊕ Q ⟼τ ≺ P'"
by(auto dest: Sum1 Sum2)
ultimately show ?case by blast
next
case(Par P Q)
have "hnf (P ∥ Q)" by fact
hence False by simp
thus ?case by simp
next
case(Res x P)
thus ?case by(auto elim: resCasesF)
next
case(Bang P)
have "hnf (!P)" by fact
hence False by simp
thus ?case by simp
qed
next
from assms show "P ⟼a<x> ≺ P' = (a<x>.P' ∈ summands P)"
proof(induct P rule: pi.induct)
case PiNil
show ?case by auto
next
case(Output c b P)
show ?case by auto
next
case(Tau P)
show ?case by auto
next
case(Input b y P)
have "b<y>.P ⟼a<x> ≺ P' ⟹ a<x>.P' ∈ summands (b<y>.P)"
by(auto elim: inputCases' simp add: pi.inject residual.inject)
moreover have "a<x>.P' ∈ summands (b<y>.P) ⟹ b<y>.P ⟼a<x> ≺ P'"
apply(auto simp add: pi.inject name_abs_eq intro: Late_Semantics.Input)
apply(subgoal_tac "b<x> ≺ [(x, y)] ∙ P = (b<y> ≺ [(x, y)] ∙ [(x, y)] ∙ P)")
apply(auto intro: Late_Semantics.Input)
by(simp add: alphaBoundResidual name_swap)
ultimately show ?case by blast
next
case(Match a b P)
have "hnf ([a⌢b]P)" by fact
hence False by simp
thus ?case by simp
next
case(Mismatch a b P)
have "hnf ([a≠b]P)" by fact
hence False by simp
thus ?case by simp
next
case(Sum P Q)
have "hnf (P ⊕ Q)" by fact
hence Phnf: "hnf P" and Qhnf: "hnf Q" by simp+
have IHP: "P ⟼a<x> ≺ P' = (a<x>.P' ∈ summands P)"
proof -
have "hnf P ⟹ P ⟼a<x> ≺ P' = (a<x>.P' ∈ summands P)" by fact
with Phnf show ?thesis by simp
qed
have IHQ: "Q ⟼a<x> ≺ P' = (a<x>.P' ∈ summands Q)"
proof -
have "hnf Q ⟹ Q ⟼a<x> ≺ P' = (a<x>.P' ∈ summands Q)" by fact
with Qhnf show ?thesis by simp
qed
from IHP IHQ have "P ⊕ Q ⟼a<x> ≺ P' ⟹ a<x>.P' ∈ summands (P ⊕ Q)"
by(erule_tac sumCases, auto)
moreover from IHP IHQ have "a<x>.P' ∈ summands (P ⊕ Q) ⟹ P ⊕ Q ⟼a<x> ≺ P'"
by(auto dest: Sum1 Sum2)
ultimately show ?case by blast
next
case(Par P Q)
have "hnf (P ∥ Q)" by fact
hence False by simp
thus ?case by simp
next
case(Res y P)
have "hnf(<νy>P)" by fact
thus ?case by(auto simp add: if_split)
next
case(Bang P)
have "hnf (!P)" by fact
hence False by simp
thus ?case by simp
qed
next
from assms show "P ⟼a[b] ≺ P' = (a{b}.P' ∈ summands P)"
proof(induct P rule: pi.induct)
case PiNil
show ?case by auto
next
case(Output c d P)
have "c{d}.P ⟼a[b] ≺ P' ⟹ a{b}.P' ∈ summands (c{d}.P)"
by(auto elim: outputCases simp add: residual.inject pi.inject)
moreover have "a{b}.P' ∈ summands (c{d}.P) ⟹ c{d}.P ⟼a[b] ≺ P'"
by(auto simp add: pi.inject intro: transitions.Output)
ultimately show ?case by blast
next
case(Tau P)
show ?case by auto
next
case(Input c x P)
show ?case by auto
next
case(Match a b P)
have "hnf ([a⌢b]P)" by fact
hence False by simp
thus ?case by simp
next
case(Mismatch a b P)
have "hnf ([a≠b]P)" by fact
hence False by simp
thus ?case by simp
next
case(Sum P Q)
have "hnf (P ⊕ Q)" by fact
hence Phnf: "hnf P" and Qhnf: "hnf Q" by simp+
have IHP: "P ⟼a[b] ≺ P' = (a{b}.P' ∈ summands P)"
proof -
have "hnf P ⟹ P ⟼a[b] ≺ P' = (a{b}.P' ∈ summands P)" by fact
with Phnf show ?thesis by simp
qed
have IHQ: "Q ⟼a[b] ≺ P' = (a{b}.P' ∈ summands Q)"
proof -
have "hnf Q ⟹ Q ⟼a[b] ≺ P' = (a{b}.P' ∈ summands Q)" by fact
with Qhnf show ?thesis by simp
qed
from IHP IHQ have "P ⊕ Q ⟼a[b] ≺ P' ⟹ a{b}.P' ∈ summands (P ⊕ Q)"
by(erule_tac sumCases, auto)
moreover from IHP IHQ have "a{b}.P' ∈ summands (P ⊕ Q) ⟹ P ⊕ Q ⟼a[b] ≺ P'"
by(auto dest: Sum1 Sum2)
ultimately show ?case by blast
next
case(Par P Q)
have "hnf (P ∥ Q)" by fact
hence False by simp
thus ?case by simp
next
case(Res x P)
have "hnf (<νx>P)" by fact
thus ?case by(force elim: resCasesF outputCases simp add: if_split residual.inject)
next
case(Bang P)
have "hnf (!P)" by fact
hence False by simp
thus ?case by simp
qed
next
assume "a≠x"
with assms show "P ⟼a<νx> ≺ P' = (<νx>a{x}.P' ∈ summands P)"
proof(nominal_induct P avoiding: x P' rule: pi.strong_induct)
case PiNil
show ?case by auto
next
case(Output a b P)
show ?case by auto
next
case(Tau P)
show ?case by auto
next
case(Input a x P)
show ?case by auto
next
case(Match a b P)
have "hnf ([a⌢b]P)" by fact
hence False by simp
thus ?case by simp
next
case(Mismatch a b P)
have "hnf ([a≠b]P)" by fact
hence False by simp
thus ?case by simp
next
case(Sum P Q)
have "hnf (P ⊕ Q)" by fact
hence Phnf: "hnf P" and Qhnf: "hnf Q" by simp+
have aineqx: "a ≠ x" by fact
have IHP: "P ⟼a<νx> ≺ P' = (<νx>a{x}.P' ∈ summands P)"
proof -
have "⋀x P'. ⟦hnf P; a ≠ x⟧ ⟹ P ⟼a<νx> ≺ P' = (<νx>a{x}.P' ∈ summands P)" by fact
with Phnf aineqx show ?thesis by simp
qed
have IHQ: "Q ⟼a<νx> ≺ P' = (<νx>a{x}.P' ∈ summands Q)"
proof -
have "⋀x Q'. ⟦hnf Q; a ≠ x⟧ ⟹ Q ⟼a<νx> ≺ P' = (<νx>a{x}.P' ∈ summands Q)" by fact
with Qhnf aineqx show ?thesis by simp
qed
from IHP IHQ have "P ⊕ Q ⟼a<νx> ≺ P' ⟹ <νx>a{x}.P' ∈ summands (P ⊕ Q)"
by(erule_tac sumCases, auto)
moreover from IHP IHQ have "<νx>a{x}.P' ∈ summands (P ⊕ Q) ⟹ P ⊕ Q ⟼a<νx> ≺ P'"
by(auto dest: Sum1 Sum2)
ultimately show ?case by blast
next
case(Par P Q)
have "hnf (P ∥ Q)" by fact
hence False by simp
thus ?case by simp
next
case(Res y P)
have Phnf: "hnf (<νy>P)" by fact
then obtain b P'' where bineqy: "b ≠ y" and PeqP'': "P = b{y}.P''"
by auto
have "y ♯ x" by fact hence xineqy: "x ≠ y" by simp
have yFreshP': "y ♯ P'" by fact
have aineqx: "a≠x" by fact
have "<νy>P ⟼a<νx> ≺ P' ⟹ (<νx>a{x}.P' ∈ summands (<νy>P))"
proof -
assume Trans: "<νy>P ⟼a<νx> ≺ P'"
hence aeqb: "a = b" using xineqy bineqy PeqP''
by(induct rule: resCasesB', auto elim: outputCases simp add: residual.inject alpha' abs_fresh pi.inject)
have Goal: "⋀x P'. ⟦<νy>b{y}.P'' ⟼b<νx> ≺ P'; x ≠ y; x ≠ b; x ♯ P''⟧ ⟹
<νx>b{x}.P' ∈ summands(<νy>b{y}.P'')"
proof -
fix x P'
assume xFreshP'': "(x::name) ♯ P''" and xineqb: "x ≠ b"
assume "<νy>b{y}.P'' ⟼b<νx> ≺ P'" and xineqy: "x ≠ y"
moreover from ‹x ≠ b› ‹x ♯ P''› ‹x ≠ y› have "x ♯ b{y}.P''" by simp
ultimately show "<νx>b{x}.P' ∈ summands (<νy>b{y}.P'')"
proof(induct rule: resCasesB)
case(cOpen a P''')
have "BoundOutputS b = BoundOutputS a" by fact hence beqa: "b = a" by simp
have Trans: "b{y}.P'' ⟼a[y] ≺ P'''" by fact
with PeqP'' have P''eqP''': "P'' = P'''"
by(force elim: outputCases simp add: residual.inject)
with bineqy xineqy xFreshP'' have "y ♯ b{x}.([(x, y)] ∙ P''')"
by(simp add: name_fresh_abs name_calc name_fresh_left)
with bineqy Phnf PeqP'' P''eqP''' xineqb show ?case
by(simp only: alphaRes, simp add: name_calc)
next
case(cRes P''')
have "b{y}.P'' ⟼b<νx> ≺ P'''" by fact
hence False by auto
thus ?case by simp
qed
qed
obtain z where zineqx: "z ≠ x" and zineqy: "z ≠ y" and zFreshP'': "z ♯ P''"
and zineqb: "z ≠ b" and zFreshP': "z ♯ P'"
by(force intro: name_exists_fresh[of "(x, y, b, P'', P')"] simp add: fresh_prod)
from zFreshP' aeqb PeqP'' Trans have Trans': "<νy>b{y}.P'' ⟼b<νz> ≺ [(z, x)] ∙ P'"
by(simp add: alphaBoundResidual name_swap)
hence "<νz>b{z}.([(z, x)] ∙ P') ∈ summands (<νy>b{y}.P'')" using zineqy zineqb zFreshP''
by(rule Goal)
moreover from bineqy zineqx zFreshP' aineqx aeqb have "x ♯ b{z}.([(z, x)] ∙ P')"
by(simp add: name_fresh_left name_calc)
ultimately have "<νx>b{x}.P' ∈ summands (<νy>b{y}.P'')" using zineqb
by(simp add: alphaRes name_calc)
with aeqb PeqP'' show ?thesis by blast
qed
moreover have "<νx>a{x}.P' ∈ summands(<νy>P) ⟹ <νy>P ⟼a<νx> ≺ P'"
proof -
assume "<νx>a{x}.P' ∈ summands(<νy>P)"
with PeqP'' have Summ: "<νx>a{x}.P' ∈ summands(<νy>b{y}.P'')" by simp
moreover with bineqy xineqy have aeqb: "a = b"
by(auto simp add: if_split pi.inject name_abs_eq name_fresh_fresh)
from bineqy xineqy yFreshP' have "y ♯ b{x}.P'" by(simp add: name_calc)
with Summ aeqb bineqy aineqx have "<νy>b{y}.([(x, y)] ∙ P') ∈ summands(<νy>b{y}.P'')"
by(simp only: alphaRes, simp add: name_calc)
with aeqb PeqP'' have "<νy>P ⟼a<νy> ≺ [(x, y)] ∙ P'"
by(auto intro: Open Output simp add: if_split pi.inject name_abs_eq)
moreover from yFreshP' have "x ♯ [(x, y)] ∙ P'" by(simp add: name_fresh_left name_calc)
ultimately show ?thesis by(simp add: alphaBoundResidual name_swap)
qed
ultimately show ?case by blast
next
case(Bang P)
have "hnf (!P)" by fact
hence False by simp
thus ?case by simp
qed
qed
definition "expandSet" :: "pi ⇒ pi ⇒ pi set" where
"expandSet P Q ≡ {τ.(P' ∥ Q) | P'. τ.(P') ∈ summands P} ∪
{τ.(P ∥ Q') | Q'. τ.(Q') ∈ summands Q} ∪
{a{b}.(P' ∥ Q) | a b P'. a{b}.P' ∈ summands P} ∪
{a{b}.(P ∥ Q') | a b Q'. a{b}.Q' ∈ summands Q} ∪
{a<x>.(P' ∥ Q) | a x P'. a<x>.P' ∈ summands P ∧ x ♯ Q} ∪
{a<x>.(P ∥ Q') | a x Q'. a<x>.Q' ∈ summands Q ∧ x ♯ P} ∪
{<νx>a{x}.(P' ∥ Q) | a x P'. <νx>a{x}.P' ∈ summands P ∧ x ♯ Q} ∪
{<νx>a{x}.(P ∥ Q') | a x Q'. <νx>a{x}.Q' ∈ summands Q ∧ x ♯ P} ∪
{τ.(P'[x::=b] ∥ Q') | x P' b Q'. ∃a. a<x>.P' ∈ summands P ∧ a{b}.Q' ∈ summands Q} ∪
{τ.(P' ∥ (Q'[x::=b])) | b P' x Q'. ∃a. a{b}.P' ∈ summands P ∧ a<x>.Q' ∈ summands Q} ∪
{τ.(<νy>(P'[x::=y] ∥ Q')) | x P' y Q'. ∃a. a<x>.P' ∈ summands P ∧ <νy>a{y}.Q' ∈ summands Q ∧ y ♯ P} ∪
{τ.(<νy>(P' ∥ (Q'[x::=y]))) | y P' x Q'. ∃a. <νy>a{y}.P' ∈ summands P ∧ a<x>.Q' ∈ summands Q ∧ y ♯ Q}"
lemma finiteExpand:
fixes P :: pi
and Q :: pi
shows "finite(expandSet P Q)"
proof -
have "finite {τ.(P' ∥ Q) | P'. τ.(P') ∈ summands P}"
by(induct P rule: pi.induct, auto simp add: pi.inject Collect_ex_eq conj_disj_distribL
Collect_disj_eq UN_Un_distrib)
moreover have "finite {τ.(P ∥ Q') | Q'. τ.(Q') ∈ summands Q}"
by(induct Q rule: pi.induct, auto simp add: pi.inject Collect_ex_eq conj_disj_distribL
Collect_disj_eq UN_Un_distrib)
moreover have "finite {a{b}.(P' ∥ Q) | a b P'. a{b}.P' ∈ summands P}"
by(induct P rule: pi.induct, auto simp add: pi.inject Collect_ex_eq conj_disj_distribL
Collect_disj_eq UN_Un_distrib)
moreover have "finite {a{b}.(P ∥ Q') | a b Q'. a{b}.Q' ∈ summands Q}"
by(induct Q rule: pi.induct, auto simp add: pi.inject Collect_ex_eq conj_disj_distribL
Collect_disj_eq UN_Un_distrib)
moreover have "finite {a<x>.(P' ∥ Q) | a x P'. a<x>.P' ∈ summands P ∧ x ♯ Q}"
proof -
have Aux: "⋀a x P Q. (x::name) ♯ Q ⟹ {a'<x'>.(P' ∥ Q) |a' x' P'. a'<x'>.P' = a<x>.P ∧ x' ♯ Q} = {a<x>.(P ∥ Q)}"
by(auto simp add: pi.inject name_abs_eq name_fresh_fresh)
thus ?thesis
by(nominal_induct P avoiding: Q rule: pi.strong_induct,
auto simp add: Collect_ex_eq conj_disj_distribL conj_disj_distribR
Collect_disj_eq UN_Un_distrib)
qed
moreover have "finite {a<x>.(P ∥ Q') | a x Q'. a<x>.Q' ∈ summands Q ∧ x ♯ P}"
proof -
have Aux: "⋀a x P Q. (x::name) ♯ P ⟹ {a'<x'>.(P ∥ Q') |a' x' Q'. a'<x'>.Q' = a<x>.Q ∧ x' ♯ P} = {a<x>.(P ∥ Q)}"
by(auto simp add: pi.inject name_abs_eq name_fresh_fresh)
thus ?thesis
by(nominal_induct Q avoiding: P rule: pi.strong_induct,
auto simp add: Collect_ex_eq conj_disj_distribL conj_disj_distribR
Collect_disj_eq UN_Un_distrib)
qed
moreover have "finite {<νx>a{x}.(P' ∥ Q) | a x P'. <νx>a{x}.P' ∈ summands P ∧ x ♯ Q}"
proof -
have Aux: "⋀a x P Q. ⟦x ♯ Q; a ≠ x⟧ ⟹ {<νx'>a'{x'}.(P' ∥ Q) |a' x' P'. <νx'>a'{x'}.P' = <νx>a{x}.P ∧ x' ♯ Q} =
{<νx>a{x}.(P ∥ Q)}"
by(auto simp add: pi.inject name_abs_eq name_fresh_fresh)
thus ?thesis
by(nominal_induct P avoiding: Q rule: pi.strong_induct,
auto simp add: Collect_ex_eq conj_disj_distribL conj_disj_distribR
Collect_disj_eq UN_Un_distrib)
qed
moreover have "finite {<νx>a{x}.(P ∥ Q') | a x Q'. <νx>a{x}.Q' ∈ summands Q ∧ x ♯ P}"
proof -
have Aux: "⋀a x P Q. ⟦x ♯ P; a ≠ x⟧ ⟹ {<νx'>a'{x'}.(P ∥ Q') |a' x' Q'. <νx'>a'{x'}.Q' = <νx>a{x}.Q ∧ x' ♯ P} =
{<νx>a{x}.(P ∥ Q)}"
by(auto simp add: pi.inject name_abs_eq name_fresh_fresh)
thus ?thesis
by(nominal_induct Q avoiding: P rule: pi.strong_induct,
auto simp add: Collect_ex_eq conj_disj_distribL conj_disj_distribR
Collect_disj_eq UN_Un_distrib)
qed
moreover have "finite {τ.(P'[x::=b] ∥ Q') | x P' b Q'. ∃a. a<x>.P' ∈ summands P ∧ a{b}.Q' ∈ summands Q}"
proof -
have Aux: "⋀a x P b Q. {τ.(P'[x'::=b'] ∥ Q') | a' x' P' b' Q'. a'<x'>.P' = a<x>.P ∧ a'{b'}.Q' = a{b}.Q} = {τ.(P[x::=b] ∥ Q)}"
by(auto simp add: name_abs_eq pi.inject renaming)
have "⋀a x P Q b::'a::{}. finite {τ.(P'[x'::=b] ∥ Q') | a' x' P' b Q'. a'<x'>.P' = a<x>.P ∧ a'{b}.Q' ∈ summands Q}"
apply(induct rule: pi.induct, simp_all)
apply(case_tac "a=name1")
apply(simp add: Aux)
apply(simp add: pi.inject)
by(simp add: Collect_ex_eq conj_disj_distribL conj_disj_distribR
Collect_disj_eq UN_Un_distrib)
hence "finite {τ.(P'[x::=b] ∥ Q') | a x P' b Q'. a<x>.P' ∈ summands P ∧ a{b}.Q' ∈ summands Q}"
by(nominal_induct P avoiding: Q rule: pi.strong_induct,
auto simp add: Collect_ex_eq conj_disj_distribL conj_disj_distribR
Collect_disj_eq UN_Un_distrib name_abs_eq)
thus ?thesis
apply(rule_tac finite_subset)
defer
by blast+
qed
moreover have "finite {τ.(P' ∥ (Q'[x::=b])) | b P' x Q'. ∃a. a{b}.P' ∈ summands P ∧ a<x>.Q' ∈ summands Q}"
proof -
have Aux: "⋀a x P b Q. {τ.(P' ∥ (Q'[x'::=b'])) | a' b' P' x' Q'. a'{b'}.P' = a{b}.P ∧ a'<x'>.Q' = a<x>.Q} = {τ.(P ∥ (Q[x::=b]))}"
by(auto simp add: name_abs_eq pi.inject renaming)
have "⋀a b P Q x::'a::{}. finite {τ.(P' ∥ (Q'[x::=b'])) | a' b' P' x Q'. a'{b'}.P' = a{b}.P ∧ a'<x>.Q' ∈ summands Q}"
apply(induct rule: pi.induct, simp_all)
apply(case_tac "a=name1")
apply(simp add: Aux)
apply(simp add: pi.inject)
by(simp add: Collect_ex_eq conj_disj_distribL conj_disj_distribR
Collect_disj_eq UN_Un_distrib)
hence "finite {τ.(P' ∥ (Q'[x::=b])) | a b P' x Q'. a{b}.P' ∈ summands P ∧ a<x>.Q' ∈ summands Q}"
by(nominal_induct P avoiding: Q rule: pi.strong_induct,
auto simp add: Collect_ex_eq conj_disj_distribL conj_disj_distribR
Collect_disj_eq UN_Un_distrib name_abs_eq)
thus ?thesis
apply(rule_tac finite_subset) defer by blast+
qed
moreover have "finite {τ.(<νy>(P'[x::=y] ∥ Q')) | x P' y Q'. ∃a. a<x>.P' ∈ summands P ∧ <νy>a{y}.Q' ∈ summands Q ∧ y ♯ P}"
proof -
have Aux: "⋀a x P y Q. y ♯ P ∧ y ≠ a ⟹ {τ.(<νy'>(P'[x'::=y'] ∥ Q')) | a' x' P' y' Q'. a'<x'>.P' = a<x>.P ∧ <νy'>a'{y'}.Q' = <νy>a{y}.Q ∧ y' ♯ a<x>.P} = {τ.(<νy>(P[x::=y] ∥ Q))}"
apply(auto simp add: pi.inject name_abs_eq name_fresh_abs name_calc fresh_fact2 fresh_fact1 eqvts forget)
apply(subst name_swap, simp add: injPermSubst fresh_fact1 fresh_fact2)+
by(simp add: name_swap injPermSubst)+
have BC: "⋀a x P Q. finite {τ.(<νy>(P'[x'::=y] ∥ Q')) | a' x' P' y Q'. a'<x'>.P' = a<x>.P ∧ <νy>a'{y}.Q' ∈ summands Q ∧ y ♯ a<x>.P}"
proof -
fix a x P Q
show "finite {τ.(<νy>(P'[x'::=y] ∥ Q')) | a' x' P' y Q'. a'<x'>.P' = a<x>.P ∧ <νy>a'{y}.Q' ∈ summands Q ∧ y ♯ a<x>.P}"
apply(nominal_induct Q avoiding: a P rule: pi.strong_induct, simp_all)
apply(simp add: Collect_ex_eq conj_disj_distribL conj_disj_distribR
Collect_disj_eq UN_Un_distrib)
apply(clarsimp)
apply(case_tac "a=aa")
apply(insert Aux, auto)
by(simp add: pi.inject name_abs_eq name_calc)
qed
have IH: "⋀P P' Q. {τ.(<νy>(P''[x::=y] ∥ Q')) | a x P'' y Q'. (a<x>.P'' ∈ summands P ∨ a<x>.P'' ∈ summands P') ∧ <νy>a{y}.Q' ∈ summands Q ∧ y ♯ P ∧ y ♯ P'} = {τ.(<νy>(P''[x::=y] ∥ Q')) | a x P'' y Q'. a<x>.P'' ∈ summands P ∧ <νy>a{y}.Q' ∈ summands Q ∧ y ♯ P ∧ y ♯ P'} ∪ {τ.(<νy>(P''[x::=y] ∥ Q')) | a x P'' y Q'. a<x>.P'' ∈ summands P' ∧ <νy>a{y}.Q' ∈ summands Q ∧ y ♯ P ∧ y ♯ P'}"
by blast
have IH': "⋀P Q P'. {τ.(<νy>(P''[x::=y] ∥ Q')) | a x P'' y Q'. a<x>.P'' ∈ summands P ∧ <νy>a{y}.Q' ∈ summands Q ∧ y ♯ P ∧ y ♯ P'} ⊆ {τ.(<νy>(P''[x::=y] ∥ Q')) | a x P'' y Q'. a<x>.P'' ∈ summands P ∧ <νy>a{y}.Q' ∈ summands Q ∧ y ♯ P}"
by blast
have IH'': "⋀P Q P'. {τ.(<νy>(P''[x::=y] ∥ Q')) | a x P'' y Q'. a<x>.P'' ∈ summands P' ∧ <νy>a{y}.Q' ∈ summands Q ∧ y ♯ P ∧ y ♯ P'} ⊆ {τ.(<νy>(P''[x::=y] ∥ Q')) | a x P'' y Q'. a<x>.P'' ∈ summands P' ∧ <νy>a{y}.Q' ∈ summands Q ∧ y ♯ P'}"
by blast
have "finite {τ.(<νy>(P'[x::=y] ∥ Q')) | a x P' y Q'. a<x>.P' ∈ summands P ∧ <νy>a{y}.Q' ∈ summands Q ∧ y ♯ P}"
apply(nominal_induct P avoiding: Q rule: pi.strong_induct, simp_all)
apply(insert BC, force)
apply(insert IH, auto)
apply(blast intro: finite_subset[OF IH'])
by(blast intro: finite_subset[OF IH''])
thus ?thesis
apply(rule_tac finite_subset) defer by(blast)+
qed
moreover have "finite {τ.(<νy>(P' ∥ (Q'[x::=y]))) | y P' x Q'. ∃a. <νy>a{y}.P' ∈ summands P ∧ a<x>.Q' ∈ summands Q ∧ y ♯ Q}"
proof -
have Aux: "⋀a y P x Q. ⟦y ♯ Q; y ≠ a⟧ ⟹ {τ.(<νy'>(P' ∥ (Q'[x'::=y']))) | a' y' P' x' Q'. <νy'>a'{y'}.P' = <νy>a{y}.P ∧ a'<x'>.Q' = a<x>.Q ∧ y' ♯ a<x>.Q} = {τ.(<νy>(P ∥ (Q[x::=y])))}"
apply(auto simp add: pi.inject name_abs_eq name_fresh_abs name_calc fresh_fact2 fresh_fact1 forget eqvts fresh_left renaming[symmetric])
apply(subst name_swap, simp add: injPermSubst fresh_fact1 fresh_fact2)+
by(simp add: name_swap injPermSubst)+
have IH: "⋀P y a Q Q'. {τ.(<νy'>(P' ∥ (Q''[x::=y']))) | a' y' P' x Q''. <νy'>a'{y'}.P' = <νy>a{y}.P ∧ (a'<x>.Q'' ∈ summands Q ∨ a'<x>.Q'' ∈ summands Q') ∧ y' ♯ Q ∧ y' ♯ Q'} = {τ.(<νy'>(P' ∥ (Q''[x::=y']))) | a' y' P' x Q''. <νy'>a'{y'}.P' = <νy>a{y}.P ∧ a'<x>.Q'' ∈ summands Q ∧ y' ♯ Q ∧ y' ♯ Q'} ∪ {τ.(<νy'>(P' ∥ (Q''[x::=y']))) | a' y' P' x Q''. <νy'>a'{y'}.P' = <νy>a{y}.P ∧ a'<x>.Q'' ∈ summands Q' ∧ y' ♯ Q ∧ y' ♯ Q'}"
by blast
have IH': "⋀a y P Q Q'. {τ.(<νy'>(P' ∥ (Q''[x::=y']))) | a' y' P' x Q''. <νy'>a'{y'}.P' = <νy>a{y}.P ∧ a'<x>.Q'' ∈ summands Q ∧ y' ♯ Q ∧ y' ♯ Q'} ⊆ {τ.(<νy'>(P' ∥ (Q''[x::=y']))) | a' y' P' x Q''. <νy'>a'{y'}.P' = <νy>a{y}.P ∧ a'<x>.Q'' ∈ summands Q ∧ y' ♯ Q}"
by blast
have IH'': "⋀a y P Q Q'. {τ.(<νy'>(P' ∥ (Q''[x::=y']))) | a' y' P' x Q''. <νy'>a'{y'}.P' = <νy>a{y}.P ∧ a'<x>.Q'' ∈ summands Q' ∧ y' ♯ Q ∧ y' ♯ Q'} ⊆ {τ.(<νy'>(P' ∥ (Q''[x::=y']))) | a' y' P' x Q''. <νy'>a'{y'}.P' = <νy>a{y}.P ∧ a'<x>.Q'' ∈ summands Q' ∧ y' ♯ Q'}"
by blast
have BC: "⋀a y P Q. ⟦y ♯ Q; y ≠ a⟧ ⟹ finite {τ.(<νy'>(P' ∥ (Q'[x::=y']))) | a' y' P' x Q'. <νy'>a'{y'}.P' = <νy>a{y}.P ∧ a'<x>.Q' ∈ summands Q ∧ y' ♯ Q}"
proof -
fix a y P Q
assume "(y::name) ♯ (Q::pi)" and "y ≠ a"
thus "finite {τ.(<νy'>(P' ∥ (Q'[x::=y']))) | a' y' P' x Q'. <νy'>a'{y'}.P' = <νy>a{y}.P ∧ a'<x>.Q' ∈ summands Q ∧ y' ♯ Q}"
apply(nominal_induct Q avoiding: y rule: pi.strong_induct, simp_all)
apply(case_tac "a=name1")
apply auto
apply(subgoal_tac "ya ♯ (pi::pi)")
apply(insert Aux)
apply auto
apply(simp add: name_fresh_abs)
apply(simp add: pi.inject name_abs_eq name_calc)
apply(insert IH)
apply auto
apply(blast intro: finite_subset[OF IH'])
by(blast intro: finite_subset[OF IH''])
qed
have "finite {τ.(<νy>(P' ∥ (Q'[x::=y]))) | a y P' x Q'. <νy>a{y}.P' ∈ summands P ∧ a<x>.Q' ∈ summands Q ∧ y ♯ Q}"
apply(nominal_induct P avoiding: Q rule: pi.strong_induct, simp_all)
apply(simp add: Collect_ex_eq conj_disj_distribL conj_disj_distribR name_fresh_abs
Collect_disj_eq UN_Un_distrib)
by(auto intro: BC)
thus ?thesis
apply(rule_tac finite_subset) defer by blast+
qed
ultimately show ?thesis
by(simp add: expandSet_def)
qed
lemma expandHnf:
fixes P :: pi
and Q :: pi
shows "∀R ∈ (expandSet P Q). hnf R"
by(force simp add: expandSet_def)
inductive_set sumComposeSet :: "(pi × pi set) set"
where
empty: "(𝟬, {}) ∈ sumComposeSet"
| insert: "⟦Q ∈ S; (P, S - {Q}) ∈ sumComposeSet⟧ ⟹ (P ⊕ Q, S) ∈ sumComposeSet"
lemma expandAction:
fixes P :: pi
and Q :: pi
and S :: "pi set"
assumes "(P, S) ∈ sumComposeSet"
and "Q ∈ S"
and "Q ⟼ Rs"
shows "P ⟼ Rs"
using assms
proof(induct arbitrary: Q rule: sumComposeSet.induct)
case empty
have "Q ∈ {}" by fact
hence False by simp
thus ?case by simp
next
case(insert Q' S P Q)
have QTrans: "Q ⟼ Rs" by fact
show ?case
proof(case_tac "Q = Q'")
assume "Q = Q'"
with QTrans show "P ⊕ Q' ⟼ Rs" by(blast intro: Sum2)
next
assume QineqQ': "Q ≠ Q'"
have IH: "⋀Q. ⟦Q ∈ S - {Q'}; Q ⟼ Rs⟧ ⟹ P ⟼ Rs" by fact
have QinS: "Q ∈ S" by fact
with QineqQ' have "Q ∈ S - {Q'}" by simp
hence "P ⟼ Rs" using QTrans by(rule IH)
thus ?case by(rule Sum1)
qed
qed
lemma expandAction':
fixes P :: pi
and Q :: pi
and R :: pi
assumes "(R, S) ∈ sumComposeSet"
and "R ⟼ Rs"
shows "∃P ∈ S. P ⟼ Rs"
using assms
proof(induct rule: sumComposeSet.induct)
case empty
have "𝟬 ⟼ Rs" by fact
hence False by blast
thus ?case by simp
next
case(insert Q S P)
have QinS: "Q ∈ S" by fact
have "P ⊕ Q ⟼ Rs" by fact
thus ?case
proof(induct rule: sumCases)
case cSum1
have "P ⟼ Rs" by fact
moreover have "P ⟼ Rs ⟹ ∃P ∈ (S - {Q}). P ⟼ Rs" by fact
ultimately obtain P where PinS: "P ∈ (S - {Q})" and PTrans: "P ⟼ Rs" by blast
show ?case
proof(case_tac "P = Q")
assume "P = Q"
with PTrans QinS show ?case by blast
next
assume PineqQ: "P ≠ Q"
from PinS have "P ∈ S" by simp
with PTrans show ?thesis by blast
qed
next
case cSum2
have "Q ⟼ Rs" by fact
with QinS show ?case by blast
qed
qed
lemma expandTrans:
fixes P :: pi
and Q :: pi
and R :: pi
and a :: name
and b :: name
and x :: name
assumes Exp: "(R, expandSet P Q) ∈ sumComposeSet"
and Phnf: "hnf P"
and Qhnf: "hnf Q"
shows "(P ∥ Q ⟼τ ≺ P') = (R ⟼τ ≺ P')"
and "(P ∥ Q ⟼a[b] ≺ P') = (R ⟼a[b] ≺ P')"
and "(P ∥ Q ⟼a<x> ≺ P') = (R ⟼a<x> ≺ P')"
and "(P ∥ Q ⟼a<νx> ≺ P') = (R ⟼a<νx> ≺ P')"
proof -
show "P ∥ Q ⟼ τ ≺ P' = R ⟼ τ ≺ P'"
proof(rule iffI)
assume "P ∥ Q ⟼τ ≺ P'"
thus "R ⟼τ ≺ P'"
proof(induct rule: parCasesF[of _ _ _ _ _ "(P, Q)"])
case(cPar1 P')
have "P ⟼τ ≺ P'" by fact
with Phnf have "τ.(P') ∈ summands P" by(simp add: summandTransition)
hence "τ.(P' ∥ Q) ∈ expandSet P Q" by(auto simp add: expandSet_def)
moreover have "τ.(P' ∥ Q) ⟼τ ≺ (P' ∥ Q)" by(rule Tau)
ultimately show ?case using Exp by(blast intro: expandAction)
next
case(cPar2 Q')
have "Q ⟼τ ≺ Q'" by fact
with Qhnf have "τ.(Q') ∈ summands Q" by(simp add: summandTransition)
hence "τ.(P ∥ Q') ∈ expandSet P Q" by(auto simp add: expandSet_def)
moreover have "τ.(P ∥ Q') ⟼τ ≺ (P ∥ Q')" by(rule Tau)
ultimately show ?case using Exp by(blast intro: expandAction)
next
case(cComm1 P' Q' a b x)
have "P ⟼a<x> ≺ P'" and "Q ⟼a[b] ≺ Q'" by fact+
with Phnf Qhnf have "a<x>.P' ∈ summands P" and "a{b}.Q' ∈ summands Q" by(simp add: summandTransition)+
hence "τ.(P'[x::=b] ∥ Q') ∈ expandSet P Q" by(simp add: expandSet_def, blast)
moreover have "τ.(P'[x::=b] ∥ Q') ⟼τ ≺ (P'[x::=b] ∥ Q')" by(rule Tau)
ultimately show ?case using Exp by(blast intro: expandAction)
next
case(cComm2 P' Q' a b x)
have "P ⟼a[b] ≺ P'" and "Q ⟼a<x> ≺ Q'" by fact+
with Phnf Qhnf have "a{b}.P' ∈ summands P" and "a<x>.Q' ∈ summands Q" by(simp add: summandTransition)+
hence "τ.(P' ∥ (Q'[x::=b])) ∈ expandSet P Q" by(simp add: expandSet_def, blast)
moreover have "τ.(P' ∥ (Q'[x::=b])) ⟼τ ≺ (P' ∥ (Q'[x::=b]))" by(rule Tau)
ultimately show ?case using Exp by(blast intro: expandAction)
next
case(cClose1 P' Q' a x y)
have "y ♯ (P, Q)" by fact
hence yFreshP: "y ♯ P" by(simp add: fresh_prod)
have PTrans: "P ⟼a<x> ≺ P'" by fact
with Phnf have PSumm: "a<x>.P' ∈ summands P" by(simp add: summandTransition)
have "Q ⟼a<νy> ≺ Q'" by fact
moreover from PTrans yFreshP have "y ≠ a" by(force dest: freshBoundDerivative)
ultimately have "<νy>a{y}.Q' ∈ summands Q" using Qhnf by(simp add: summandTransition)
with PSumm yFreshP have "τ.(<νy>(P'[x::=y] ∥ Q')) ∈ expandSet P Q"
by(auto simp add: expandSet_def)
moreover have "τ.(<νy>(P'[x::=y] ∥ Q')) ⟼τ ≺ <νy>(P'[x::=y] ∥ Q')" by(rule Tau)
ultimately show ?case using Exp by(blast intro: expandAction)
next
case(cClose2 P' Q' a x y)
have "y ♯ (P, Q)" by fact
hence yFreshQ: "y ♯ Q" by(simp add: fresh_prod)
have QTrans: "Q ⟼a<x> ≺ Q'" by fact
with Qhnf have QSumm: "a<x>.Q' ∈ summands Q" by(simp add: summandTransition)
have "P ⟼a<νy> ≺ P'" by fact
moreover from QTrans yFreshQ have "y ≠ a" by(force dest: freshBoundDerivative)
ultimately have "<νy>a{y}.P' ∈ summands P" using Phnf by(simp add: summandTransition)
with QSumm yFreshQ have "τ.(<νy>(P' ∥ (Q'[x::=y]))) ∈ expandSet P Q"
by(simp add: expandSet_def, blast)
moreover have "τ.(<νy>(P' ∥ (Q'[x::=y]))) ⟼τ ≺ <νy>(P' ∥ (Q'[x::=y]))" by(rule Tau)
ultimately show ?case using Exp by(blast intro: expandAction)
qed
next
assume "R ⟼τ ≺ P'"
with Exp obtain R where "R ∈ expandSet P Q" and "R ⟼τ ≺ P'" by(blast dest: expandAction')
thus "P ∥ Q ⟼τ ≺ P'"
proof(auto simp add: expandSet_def)
fix P''
assume "τ.(P'') ∈ summands P"
with Phnf have "P ⟼τ ≺ P''" by(simp add: summandTransition)
hence PQTrans: "P ∥ Q ⟼τ ≺ P'' ∥ Q" by(rule Par1F)
assume "τ.(P'' ∥ Q) ⟼τ ≺ P'"
hence "P' = P'' ∥ Q" by(erule_tac tauCases, auto simp add: pi.inject residual.inject)
with PQTrans show ?thesis by simp
next
fix Q'
assume "τ.(Q') ∈ summands Q"
with Qhnf have "Q ⟼τ ≺ Q'" by(simp add: summandTransition)
hence PQTrans: "P ∥ Q ⟼τ ≺ P ∥ Q'" by(rule Par2F)
assume "τ.(P ∥ Q') ⟼τ ≺ P'"
hence "P' = P ∥ Q'" by(erule_tac tauCases, auto simp add: pi.inject residual.inject)
with PQTrans show ?thesis by simp
next
fix a x P'' b Q'
assume "a<x>.P'' ∈ summands P" and "a{b}.Q' ∈ summands Q"
with Phnf Qhnf have "P ⟼a<x> ≺ P''" and "Q ⟼a[b] ≺ Q'" by(simp add: summandTransition)+
hence PQTrans: "P ∥ Q ⟼τ ≺ P''[x::=b] ∥ Q'" by(rule Comm1)
assume "τ.(P''[x::=b] ∥ Q') ⟼τ ≺ P'"
hence "P' = P''[x::=b] ∥ Q'" by(erule_tac tauCases, auto simp add: pi.inject residual.inject)
with PQTrans show ?thesis by simp
next
fix a b P'' x Q'
assume "a{b}.P'' ∈ summands P" and "a<x>.Q' ∈ summands Q"
with Phnf Qhnf have "P ⟼a[b] ≺ P''" and "Q ⟼a<x> ≺ Q'" by(simp add: summandTransition)+
hence PQTrans: "P ∥ Q ⟼τ ≺ P'' ∥ (Q'[x::=b])" by(rule Comm2)
assume "τ.(P'' ∥ (Q'[x::=b])) ⟼τ ≺ P'"
hence "P' = P'' ∥ (Q'[x::=b])" by(erule_tac tauCases, auto simp add: pi.inject residual.inject)
with PQTrans show ?thesis by simp
next
fix a x P'' y Q'
assume yFreshP: "(y::name) ♯ P"
assume "a<x>.P'' ∈ summands P"
with Phnf have PTrans: "P ⟼a<x> ≺ P''" by(simp add: summandTransition)
assume "<νy>a{y}.Q' ∈ summands Q"
moreover from yFreshP PTrans have "y ≠ a" by(force dest: freshBoundDerivative)
ultimately have "Q ⟼a<νy> ≺ Q'" using Qhnf by(simp add: summandTransition)
with PTrans have PQTrans: "P ∥ Q ⟼τ ≺ <νy>(P''[x::=y] ∥ Q')" using yFreshP by(rule Close1)
assume "τ.(<νy>(P''[x::=y] ∥ Q')) ⟼τ ≺ P'"
hence "P' = <νy>(P''[x::=y] ∥ Q')" by(erule_tac tauCases, auto simp add: pi.inject residual.inject)
with PQTrans show ?thesis by simp
next
fix a y P'' x Q'
assume yFreshQ: "(y::name) ♯ Q"
assume "a<x>.Q' ∈ summands Q"
with Qhnf have QTrans: "Q ⟼a<x> ≺ Q'" by(simp add: summandTransition)
assume "<νy>a{y}.P'' ∈ summands P"
moreover from yFreshQ QTrans have "y ≠ a" by(force dest: freshBoundDerivative)
ultimately have "P ⟼a<νy> ≺ P''" using Phnf by(simp add: summandTransition)
hence PQTrans: "P ∥ Q ⟼τ ≺ <νy>(P'' ∥ Q'[x::=y])" using QTrans yFreshQ by(rule Close2)
assume "τ.(<νy>(P'' ∥ Q'[x::=y])) ⟼τ ≺ P'"
hence "P' = <νy>(P'' ∥ Q'[x::=y])" by(erule_tac tauCases, auto simp add: pi.inject residual.inject)
with PQTrans show ?thesis by simp
qed
qed
next
show "P ∥ Q ⟼ a[b] ≺ P' = R ⟼ a[b] ≺ P'"
proof(rule iffI)
assume "P ∥ Q ⟼a[b] ≺ P'"
thus "R ⟼a[b] ≺ P'"
proof(induct rule: parCasesF[where C="()"])
case(cPar1 P')
have "P ⟼a[b] ≺ P'" by fact
with Phnf have "a{b}.P' ∈ summands P" by(simp add: summandTransition)
hence "a{b}.(P' ∥ Q) ∈ expandSet P Q" by(auto simp add: expandSet_def)
moreover have "a{b}.(P' ∥ Q) ⟼a[b] ≺ (P' ∥ Q)" by(rule Output)
ultimately show ?case using Exp by(blast intro: expandAction)
next
case(cPar2 Q')
have "Q ⟼a[b] ≺ Q'" by fact
with Qhnf have "a{b}.Q' ∈ summands Q" by(simp add: summandTransition)
hence "a{b}.(P ∥ Q') ∈ expandSet P Q" by(simp add: expandSet_def, blast)
moreover have "a{b}.(P ∥ Q') ⟼a[b] ≺ (P ∥ Q')" by(rule Output)
ultimately show ?case using Exp by(blast intro: expandAction)
next
case cComm1
thus ?case by auto
next
case cComm2
thus ?case by auto
next
case cClose1
thus ?case by auto
next
case cClose2
thus ?case by auto
qed
next
assume "R ⟼a[b] ≺ P'"
with Exp obtain R where "R ∈ expandSet P Q" and "R ⟼a[b] ≺ P'" by(blast dest: expandAction')
thus "P ∥ Q ⟼a[b] ≺ P'"
proof(auto simp add: expandSet_def)
fix a' b' P''
assume "a'{b'}.P'' ∈ summands P"
with Phnf have "P ⟼a'[b'] ≺ P''" by(simp add: summandTransition)
hence PQTrans: "P ∥ Q ⟼a'[b'] ≺ P'' ∥ Q" by(rule Par1F)
assume "a'{b'}.(P'' ∥ Q) ⟼a[b] ≺ P'"
hence "P' = P'' ∥ Q" and "a = a'" and "b = b'"
by(erule_tac outputCases, auto simp add: pi.inject residual.inject)+
with PQTrans show ?thesis by simp
next
fix a' b' Q'
assume "a'{b'}.Q' ∈ summands Q"
with Qhnf have "Q ⟼a'[b'] ≺ Q'" by(simp add: summandTransition)
hence PQTrans: "P ∥ Q ⟼a'[b'] ≺ P ∥ Q'" by(rule Par2F)
assume "a'{b'}.(P ∥ Q') ⟼a[b] ≺ P'"
hence "P' = P ∥ Q'" and "a = a'" and "b = b'"
by(erule_tac outputCases, auto simp add: pi.inject residual.inject)+
with PQTrans show ?thesis by simp
qed
qed
next
show "P ∥ Q ⟼ a<x> ≺ P' = R ⟼ a<x> ≺ P'"
proof(rule iffI)
{
fix x P'
assume "P ∥ Q ⟼a<x> ≺ P'" and "x ♯ P" and "x ♯ Q"
hence "R ⟼a<x> ≺ P'"
proof(induct rule: parCasesB)
case(cPar1 P')
have "P ⟼a<x> ≺ P'" by fact
with Phnf have "a<x>.P' ∈ summands P" by(simp add: summandTransition)
moreover have "x ♯ Q" by fact
ultimately have "a<x>.(P' ∥ Q) ∈ expandSet P Q" by(auto simp add: expandSet_def)
moreover have "a<x>.(P' ∥ Q) ⟼a<x> ≺ (P' ∥ Q)" by(rule Input)
ultimately show ?case using Exp by(blast intro: expandAction)
next
case(cPar2 Q')
have "Q ⟼a<x> ≺ Q'" by fact
with Qhnf have "a<x>.Q' ∈ summands Q" by(simp add: summandTransition)
moreover have "x ♯ P" by fact
ultimately have "a<x>.(P ∥ Q') ∈ expandSet P Q" by(simp add: expandSet_def, blast)
moreover have "a<x>.(P ∥ Q') ⟼a<x> ≺ (P ∥ Q')" by(rule Input)
ultimately show ?case using Exp by(blast intro: expandAction)
qed
}
moreover obtain y::name where "y ♯ P" and "y ♯ Q" and "y ♯ P'"
by(generate_fresh "name") auto
assume "P ∥ Q ⟼a<x> ≺ P'"
with ‹y ♯ P'› have "P ∥ Q ⟼a<y> ≺ ([(x, y)] ∙ P')"
by(simp add: alphaBoundResidual)
ultimately have "R ⟼a<y> ≺ ([(x, y)] ∙ P')" using ‹y ♯ P› ‹y ♯ Q›
by auto
thus "R ⟼a<x> ≺ P'" using ‹y ♯ P'› by(simp add: alphaBoundResidual)
next
assume "R ⟼a<x> ≺ P'"
with Exp obtain R where "R ∈ expandSet P Q" and "R ⟼a<x> ≺ P'" by(blast dest: expandAction')
thus "P ∥ Q ⟼a<x> ≺ P'"
proof(auto simp add: expandSet_def)
fix a' y P''
assume "a'<y>.P'' ∈ summands P"
with Phnf have "P ⟼a'<y> ≺ P''" by(simp add: summandTransition)
moreover assume "y ♯ Q"
ultimately have PQTrans: "P ∥ Q ⟼a'<y> ≺ P'' ∥ Q" by(rule Par1B)
assume "a'<y>.(P'' ∥ Q) ⟼a<x> ≺ P'"
hence "a<x> ≺ P' = a'<y> ≺ P'' ∥ Q" and "a = a'"
by(erule_tac inputCases', auto simp add: pi.inject residual.inject)+
with PQTrans show ?thesis by simp
next
fix a' y Q'
assume "a'<y>.Q' ∈ summands Q"
with Qhnf have "Q ⟼(a'::name)<y> ≺ Q'" by(simp add: summandTransition)
moreover assume "y ♯ P"
ultimately have PQTrans: "P ∥ Q ⟼a'<y> ≺ P ∥ Q'" by(rule Par2B)
assume "a'<y>.(P ∥ Q') ⟼a<x> ≺ P'"
hence "a<x> ≺ P' = a'<y> ≺ P ∥ Q'" and "a = a'"
by(erule_tac inputCases', auto simp add: pi.inject residual.inject)+
with PQTrans show ?thesis by simp
qed
qed
next
have Goal: "⋀P Q a x P' R. ⟦(R, expandSet P Q) ∈ sumComposeSet; hnf P; hnf Q; a ≠ x⟧ ⟹ P ∥ Q ⟼a<νx> ≺ P' = R ⟼a<νx> ≺ P'"
proof -
fix P Q a x P' R
assume aineqx: "(a::name) ≠ x"
assume Exp: "(R, expandSet P Q) ∈ sumComposeSet"
assume Phnf: "hnf P"
assume Qhnf: "hnf Q"
show "P ∥ Q ⟼a<νx> ≺ P' = R ⟼ a<νx> ≺ P'"
proof(rule iffI)
{
fix x P'
assume "P ∥ Q ⟼a<νx> ≺ P'" and "x ♯ P" and "x ♯ Q" and "a ≠ x"
hence "R ⟼a<νx> ≺ P'"
proof(induct rule: parCasesB)
case(cPar1 P')
have "P ⟼a<νx> ≺ P'" by fact
with Phnf ‹a ≠ x› have "<νx>a{x}.P' ∈ summands P" by(simp add: summandTransition)
moreover have "x ♯ Q" by fact
ultimately have "<νx>a{x}.(P' ∥ Q) ∈ expandSet P Q" by(auto simp add: expandSet_def)
moreover have "<νx>a{x}.(P' ∥ Q) ⟼a<νx> ≺ (P' ∥ Q)" using ‹a ≠ x›
by(blast intro: Open Output)
ultimately show ?case using Exp by(blast intro: expandAction)
next
case(cPar2 Q')
have "Q ⟼a<νx> ≺ Q'" by fact
with Qhnf ‹a ≠ x› have "<νx>a{x}.Q' ∈ summands Q" by(simp add: summandTransition)
moreover have "x ♯ P" by fact
ultimately have "<νx>a{x}.(P ∥ Q') ∈ expandSet P Q" by(simp add: expandSet_def, blast)
moreover have "<νx>a{x}.(P ∥ Q') ⟼a<νx> ≺ (P ∥ Q')" using ‹a ≠ x›
by(blast intro: Open Output)
ultimately show ?case using Exp by(blast intro: expandAction)
qed
}
moreover obtain y::name where "y ♯ P" and "y ♯ Q" and "y ♯ P'" and "y ≠ a"
by(generate_fresh "name") auto
assume "P ∥ Q ⟼a<νx> ≺ P'"
with ‹y ♯ P'› have "P ∥ Q ⟼a<νy> ≺ ([(x, y)] ∙ P')"
by(simp add: alphaBoundResidual)
ultimately have "R ⟼a<νy> ≺ ([(x, y)] ∙ P')" using ‹y ♯ P› ‹y ♯ Q› ‹y ≠ a›
by auto
thus "R ⟼a<νx> ≺ P'" using ‹y ♯ P'› by(simp add: alphaBoundResidual)
next
{
fix R x P'
assume "R ⟼a<νx> ≺ P'" and "R ∈ expandSet P Q" and "x ♯ R" and "x ♯ P" and "x ♯ Q"
hence "P ∥ Q ⟼a<νx> ≺ P'"
proof(auto simp add: expandSet_def)
fix a' y P''
assume "<νy>a'{y}.P'' ∈ summands P"
moreover hence "a' ≠ y" by auto
ultimately have "P ⟼a'<νy> ≺ P''" using Phnf by(simp add: summandTransition)
moreover assume "y ♯ Q"
ultimately have PQTrans: "P ∥ Q ⟼a'<νy> ≺ P'' ∥ Q" by(rule Par1B)
assume ResTrans: "<νy>a'{y}.(P'' ∥ Q) ⟼a<νx> ≺ P'" and "x ♯ [y].a'{y}.(P'' ∥ Q)"
with ResTrans ‹a' ≠ y› ‹x ♯ P› ‹x ♯ Q› have "a<νx> ≺ P' = a'<νy> ≺ P'' ∥ Q"
apply(case_tac "x=y")
defer
apply(erule_tac resCasesB)
apply simp
apply(simp add: abs_fresh)
apply(auto simp add: residual.inject alpha' calc_atm fresh_left abs_fresh elim: outputCases)
apply(ind_cases "<νy>a'{y}.(P'' ∥ Q) ⟼ a<νy> ≺ P'")
apply(simp add: pi.inject alpha' residual.inject abs_fresh eqvts calc_atm)
apply(auto elim: outputCases)
apply(simp add: pi.inject residual.inject alpha' calc_atm)
apply auto
apply(ind_cases "<νy>a'{y}.(P'' ∥ Q) ⟼ a<νy> ≺ P'")
apply(auto simp add: pi.inject alpha' residual.inject abs_fresh eqvts calc_atm)
apply(auto elim: outputCases)
apply(erule_tac outputCases)
apply(auto simp add: freeRes.inject)
apply hypsubst_thin
apply(drule_tac pi="[(b, y)]" in pt_bij3)
by simp
with PQTrans show ?thesis by simp
next
fix a' y Q'
assume "<νy>a'{y}.Q' ∈ summands Q"
moreover hence "a' ≠ y" by auto
ultimately have "Q ⟼a'<νy> ≺ Q'" using Qhnf by(simp add: summandTransition)
moreover assume "y ♯ P"
ultimately have PQTrans: "P ∥ Q ⟼a'<νy> ≺ P ∥ Q'" by(rule Par2B)
assume ResTrans: "<νy>a'{y}.(P ∥ Q') ⟼a<νx> ≺ P'" and "x ♯ [y].a'{y}.(P ∥ Q')"
with ResTrans ‹a' ≠ y› have "a<νx> ≺ P' = a'<νy> ≺ P ∥ Q'"
apply(case_tac "x=y")
defer
apply(erule_tac resCasesB)
apply simp
apply(simp add: abs_fresh)
apply(auto simp add: residual.inject alpha' calc_atm fresh_left abs_fresh elim: outputCases)
apply(ind_cases "<νy>a'{y}.(P ∥ Q') ⟼ a<νy> ≺ P'")
apply(simp add: pi.inject alpha' residual.inject abs_fresh eqvts calc_atm)
apply(auto elim: outputCases)
apply(simp add: pi.inject residual.inject alpha' calc_atm)
apply auto
apply(ind_cases "<νy>a'{y}.(P ∥ Q') ⟼ a<νy> ≺ P'")
apply(auto simp add: pi.inject alpha' residual.inject abs_fresh eqvts calc_atm)
apply(auto elim: outputCases)
apply(erule_tac outputCases)
apply(auto simp add: freeRes.inject)
apply hypsubst_thin
apply(drule_tac pi="[(b, y)]" in pt_bij3)
by simp
with PQTrans show ?thesis by simp
qed
}
moreover assume "R ⟼a<νx> ≺ P'"
with Exp obtain R where "R ∈ expandSet P Q" and "R ⟼a<νx> ≺ P'"
apply(drule_tac expandAction') by auto
moreover obtain y::name where "y ♯ P" and "y ♯ Q" and "y ♯ R" and "y ♯ P'"
by(generate_fresh "name") auto
moreover with ‹y ♯ P'› ‹R ⟼a<νx> ≺ P'› have "R ⟼a<νy> ≺ ([(x, y)] ∙ P')" by(simp add: alphaBoundResidual)
ultimately have "P ∥ Q ⟼a<νy> ≺ ([(x, y)] ∙ P')" by auto
thus "P ∥ Q ⟼a<νx> ≺ P'" using ‹y ♯ P'› by(simp add: alphaBoundResidual)
qed
qed
obtain y where yineqx: "a ≠ y" and yFreshP': "y ♯ P'"
by(force intro: name_exists_fresh[of "(a, P')"] simp add: fresh_prod)
from Exp Phnf Qhnf yineqx have "(P ∥ Q ⟼a<νy> ≺ [(x, y)] ∙ P') = (R ⟼a<νy> ≺ [(x, y)] ∙ P')"
by(rule Goal)
moreover with yFreshP' have "x ♯ [(x, y)] ∙ P'" by(simp add: name_fresh_left name_calc)
ultimately show "(P ∥ Q ⟼a<νx> ≺ P') = (R ⟼a<νx> ≺ P')"
by(simp add: alphaBoundResidual name_swap)
qed
lemma expandLeft:
fixes P :: pi
and Q :: pi
and R :: pi
and Rel :: "(pi × pi) set"
assumes Exp: "(R, expandSet P Q) ∈ sumComposeSet"
and Phnf: "hnf P"
and Qhnf: "hnf Q"
and Id: "Id ⊆ Rel"
shows "P ∥ Q ↝[Rel] R"
proof(induct rule: simCases)
case(Bound a x R')
have "R ⟼a«x» ≺ R'" by fact
with Exp Phnf Qhnf have "P ∥ Q ⟼a«x» ≺ R'" by(cases a, auto simp add: expandTrans)
moreover from Id have "derivative R' R' a x Rel" by(cases a, auto simp add: derivative_def)
ultimately show ?case by blast
next
case(Free α R')
have "R ⟼α ≺ R'" by fact
with Exp Phnf Qhnf have "P ∥ Q ⟼α ≺ R'" by(cases α, auto simp add: expandTrans)
moreover from Id have "(R', R') ∈ Rel" by blast
ultimately show ?case by blast
qed
lemma expandRight:
fixes P :: pi
and Q :: pi
and R :: pi
and Rel :: "(pi × pi) set"
assumes Exp: "(R, expandSet P Q) ∈ sumComposeSet"
and Phnf: "hnf P"
and Qhnf: "hnf Q"
and Id: "Id ⊆ Rel"
shows "R ↝[Rel] P ∥ Q"
proof(induct rule: simCases)
case(Bound a x R')
have "P ∥ Q ⟼a«x» ≺ R'" by fact
with Exp Phnf Qhnf have "R ⟼a«x» ≺ R'" by(cases a, auto simp add: expandTrans)
moreover from Id have "derivative R' R' a x Rel" by(cases a, auto simp add: derivative_def)
ultimately show ?case by blast
next
case(Free α R')
have "P ∥ Q ⟼α ≺ R'" by fact
with Exp Phnf Qhnf have "R ⟼α ≺ R'" by(cases α, auto simp add: expandTrans)
moreover from Id have "(R', R') ∈ Rel" by blast
ultimately show ?case by blast
qed
lemma expandSC:
fixes P :: pi
and Q :: pi
and R :: pi
assumes "(R, expandSet P Q) ∈ sumComposeSet"
and "hnf P"
and "hnf Q"
shows "P ∥ Q ∼ R"
proof -
let ?X = "{(P ∥ Q, R) | P Q R. (R, expandSet P Q) ∈ sumComposeSet ∧ hnf P ∧ hnf Q} ∪ {(R, P ∥ Q) | P Q R. (R, expandSet P Q) ∈ sumComposeSet ∧ hnf P ∧ hnf Q}"
from assms have "(P ∥ Q, R) ∈ ?X" by auto
thus ?thesis
proof(coinduct rule: bisimCoinduct)
case(cSim P Q)
thus ?case
by(blast intro: reflexive expandLeft expandRight)
next
case(cSym P Q)
thus ?case by auto
qed
qed
end
Theory Strong_Late_Axiomatisation
theory Strong_Late_Axiomatisation
imports Strong_Late_Expansion_Law
begin
lemma inputSuppPres:
fixes P :: pi
and Q :: pi
and x :: name
and Rel :: "(pi × pi) set"
assumes PRelQ: "⋀y. y ∈ supp(P, Q, x) ⟹ (P[x::=y], Q[x::=y]) ∈ Rel"
and Eqvt: "eqvt Rel"
shows "a<x>.P ↝[Rel] a<x>.Q"
proof -
from Eqvt show ?thesis
proof(induct rule: simCasesCont[where C="(x, a, Q, P)"])
case(Bound b y Q')
have "x ∈ supp(P, Q, x)" by(simp add: supp_prod supp_atm)
with PRelQ have "(P, Q) ∈ Rel" by fastforce
have QTrans: "a<x>.Q ⟼ b«y» ≺ Q'" by fact
have "y ♯ (x, a, Q, P)" by fact
hence "y ≠ a" and yineqx: "y ≠ x" and "y ♯ Q" and "y ♯ P" by(simp add: fresh_prod)+
with QTrans show ?case
proof(induct rule: inputCases)
have "a<y>.([(x, y)] ∙ P) ⟼a<y> ≺ ([(x, y)] ∙ P)" by(rule Input)
hence "a<x>.P ⟼a<y> ≺ ([(x, y)] ∙ P)" using ‹y ♯ P› by(simp add: alphaInput)
moreover have "derivative ([(x, y)] ∙ P) ([(x, y)] ∙ Q) (InputS a) y Rel"
proof(auto simp add: derivative_def)
fix u
have "x ∈ supp(P, Q, x)" by(simp add: supp_prod supp_atm)
have "(P[x::=u], Q[x::=u]) ∈ Rel"
proof(cases "u ∈ supp(P, Q, x)")
case True
with PRelQ show ?thesis by auto
next
case False
hence "u ♯ P" and "u ♯ Q" by(auto simp add: fresh_def supp_prod)
moreover from ‹eqvt Rel› ‹(P, Q) ∈ Rel› have "([(x, u)] ∙ P, [(x, u)] ∙ Q) ∈ Rel"
by(rule eqvtRelI)
ultimately show ?thesis by(simp only: injPermSubst)
qed
with ‹y ♯ P› ‹y ♯ Q› show "(([(x, y)] ∙ P)[y::=u], ([(x, y)] ∙ Q)[y::=u]) ∈ Rel"
by(simp add: renaming)
qed
ultimately show "∃P'. a<x>.P ⟼ a<y> ≺ P' ∧ derivative P' ([(x, y)] ∙ Q) (InputS a) y Rel"
by blast
qed
next
case(Free α Q')
have "a<x>.Q ⟼ α ≺ Q'" by fact
hence False by auto
thus ?case by blast
qed
qed
lemma inputSuppPresBisim:
fixes P :: pi
and Q :: pi
and x :: name
assumes PSimQ: "⋀y. y ∈ supp(P, Q, x) ⟹ P[x::=y] ∼ Q[x::=y]"
shows "a<x>.P ∼ a<x>.Q"
proof -
let ?X = "{(a<x>.P, a<x>.Q) | a x P Q. ∀y ∈ supp(P, Q, x). P[x::=y] ∼ Q[x::=y]}"
have "eqvt ?X"
apply(auto simp add: eqvt_def)
apply(rule_tac x="perma ∙ aa" in exI)
apply(rule_tac x="perma ∙ x" in exI)
apply(rule_tac x="perma ∙ P" in exI)
apply auto
apply(rule_tac x="perma ∙ Q" in exI)
apply auto
apply(drule_tac pi="rev perma" in pt_set_bij2[OF pt_name_inst, OF at_name_inst])
apply(simp add: eqvts pt_rev_pi[OF pt_name_inst, OF at_name_inst])
apply(erule_tac x="rev perma ∙ y" in ballE)
apply auto
apply(drule_tac p=perma in bisimClosed)
by(simp add: eqvts pt_pi_rev[OF pt_name_inst, OF at_name_inst])
from assms have "(a<x>.P, a<x>.Q) ∈ ?X" by fastforce
thus ?thesis
proof(coinduct rule: bisimCoinduct)
case(cSim P Q)
thus ?case using ‹eqvt ?X›
by(fastforce intro: inputSuppPres)
next
case(cSym P Q)
thus ?case by(fastforce simp add: supp_prod dest: symmetric)
qed
qed
inductive equiv :: "pi ⇒ pi ⇒ bool" (infixr "≡⇩e" 80)
where
Refl: "P ≡⇩e P"
| Sym: "P ≡⇩e Q ⟹ Q ≡⇩e P"
| Trans: "⟦P ≡⇩e Q; Q ≡⇩e R⟧ ⟹ P ≡⇩e R"
| Match: "[a⌢a]P ≡⇩e P"
| Match': "a ≠ b ⟹ [a⌢b]P ≡⇩e 𝟬"
| Mismatch: "a ≠ b ⟹ [a≠b]P ≡⇩e P"
| Mismatch': "[a≠a]P ≡⇩e 𝟬"
| SumSym: "P ⊕ Q ≡⇩e Q ⊕ P"
| SumAssoc: "(P ⊕ Q) ⊕ R ≡⇩e P ⊕ (Q ⊕ R)"
| SumZero: "P ⊕ 𝟬 ≡⇩e P"
| SumIdemp: "P ⊕ P ≡⇩e P"
| SumRes: "<νx>(P ⊕ Q) ≡⇩e (<νx>P) ⊕ (<νx>Q)"
| ResNil: "<νx>𝟬 ≡⇩e 𝟬"
| ResInput: "⟦x ≠ a; x ≠ y⟧ ⟹ <νx>a<y>.P ≡⇩e a<y>.(<νx>P)"
| ResInput': "<νx>x<y>.P ≡⇩e 𝟬"
| ResOutput: "⟦x ≠ a; x ≠ b⟧ ⟹ <νx>a{b}.P ≡⇩e a{b}.(<νx>P)"
| ResOutput': "<νx>x{b}.P ≡⇩e 𝟬"
| ResTau: "<νx>τ.(P) ≡⇩e τ.(<νx>P)"
| ResComm: "<νx><νy>P ≡⇩e <νy><νx>P"
| ResFresh: "x ♯ P ⟹ <νx>P ≡⇩e P"
| Expand: "⟦(R, expandSet P Q) ∈ sumComposeSet; hnf P; hnf Q⟧ ⟹ P ∥ Q ≡⇩e R"
| SumPres: "P ≡⇩e Q ⟹ P ⊕ R ≡⇩e Q ⊕ R"
| ParPres: "⟦P ≡⇩e P'; Q ≡⇩e Q'⟧ ⟹ P ∥ Q ≡⇩e P' ∥ Q'"
| ResPres: "P ≡⇩e Q ⟹ <νx>P ≡⇩e <νx>Q"
| TauPres: "P ≡⇩e Q ⟹ τ.(P) ≡⇩e τ.(Q)"
| OutputPres: "P ≡⇩e Q ⟹ a{b}.P ≡⇩e a{b}.Q"
| InputPres: "⟦∀y ∈ supp(P, Q, x). P[x::=y] ≡⇩e Q[x::=y]⟧ ⟹ a<x>.P ≡⇩e a<x>.Q"
lemma SumIdemp':
fixes P :: pi
and P' :: pi
assumes "P ≡⇩e P'"
shows "P ⊕ P' ≡⇩e P"
proof -
have "P ≡⇩e P ⊕ P" by(blast intro: Sym SumIdemp)
moreover from assms have "P ⊕ P ≡⇩e P' ⊕ P" by(rule SumPres)
moreover have "P' ⊕ P ≡⇩e P ⊕ P'" by(rule SumSym)
ultimately have "P ≡⇩e P ⊕ P'" by(blast intro: Trans)
thus ?thesis by(rule Sym)
qed
lemma SumPres':
fixes P :: pi
and P' :: pi
and Q :: pi
and Q' :: pi
assumes PeqP': "P ≡⇩e P'"
and QeqQ': "Q ≡⇩e Q'"
shows "P ⊕ Q ≡⇩e P' ⊕ Q'"
proof -
from PeqP' have "P ⊕ Q ≡⇩e P' ⊕ Q" by(rule SumPres)
moreover have "P' ⊕ Q ≡⇩e Q ⊕ P'" by(rule SumSym)
moreover from QeqQ' have "Q ⊕ P' ≡⇩e Q' ⊕ P'" by(rule SumPres)
moreover have "Q' ⊕ P' ≡⇩e P' ⊕ Q'" by(rule SumSym)
ultimately show ?thesis by(blast intro: Trans)
qed
lemma sound:
fixes P :: pi
and Q :: pi
assumes "P ≡⇩e Q"
shows "P ∼ Q"
using assms
proof(induct)
case(Refl P)
show ?case by(rule reflexive)
next
case(Sym P Q)
have "P ∼ Q" by fact
thus ?case by(rule symmetric)
next
case(Trans P Q R)
have "P ∼ Q" and "Q ∼ R" by fact+
thus ?case by(rule transitive)
next
case(Match a P)
show ?case by(rule matchId)
next
case(Match' a b P)
have "a ≠ b" by fact
thus ?case by(rule matchNil)
next
case(Mismatch a b P)
have "a ≠ b" by fact
thus ?case by(rule mismatchId)
next
case(Mismatch' a P)
show ?case by(rule mismatchNil)
next
case(SumSym P Q)
show ?case by(rule sumSym)
next
case(SumAssoc P Q R)
show ?case by(rule sumAssoc)
next
case(SumZero P)
show ?case by(rule sumZero)
next
case(SumIdemp P)
show ?case by(rule sumIdemp)
next
case(SumRes x P Q)
show ?case by(rule sumRes)
next
case(ResNil x)
show ?case by(rule nilRes)
next
case(ResInput x a y P)
have "x ≠ a" and "x ≠ y" by fact+
thus ?case by(rule resInput)
next
case(ResInput' x y P)
show ?case by(rule resNil)
next
case(ResOutput x a b P)
have "x ≠ a" and "x ≠ b" by fact+
thus ?case by(rule resOutput)
next
case(ResOutput' x b P)
show ?case by(rule resNil)
next
case(ResTau x P)
show ?case by(rule resTau)
next
case(ResComm x P)
show ?case by(rule resComm)
next
case(ResFresh x P)
have "x ♯ P" by fact
thus ?case by(rule scopeFresh)
next
case(Expand R P Q)
have "(R, expandSet P Q) ∈ sumComposeSet" and "hnf P" and "hnf Q" by fact+
thus ?case by(rule expandSC)
next
case(SumPres P Q R)
from ‹P ∼ Q› show ?case by(rule sumPres)
next
case(ParPres P P' Q Q')
have "P ∼ P'" and "Q ∼ Q'" by fact+
thus ?case by(metis transitive symmetric parPres parSym)
next
case(ResPres P Q x)
from ‹P ∼ Q› show ?case by(rule resPres)
next
case(TauPres P Q)
from ‹P ∼ Q› show ?case by(rule tauPres)
next
case(OutputPres P Q a b)
from ‹P ∼ Q› show ?case by(rule outputPres)
next
case(InputPres P Q x a)
have "∀y ∈ supp(P, Q, x). P[x::=y] ≡⇩e Q[x::=y] ∧ P[x::=y] ∼ Q[x::=y]" by fact
hence "∀y ∈ supp(P, Q, x). P[x::=y] ∼ Q[x::=y]" by blast
thus ?case by(rule_tac inputSuppPresBisim) auto
qed
lemma zeroDest[dest]:
fixes a :: name
and b :: name
and x :: name
and P :: pi
shows "(a{b}.P) ≡⇩e 𝟬 ⟹ False"
and "(a<x>.P) ≡⇩e 𝟬 ⟹ False"
and "(τ.(P)) ≡⇩e 𝟬 ⟹ False"
and "𝟬 ≡⇩e a{b}.P ⟹ False"
and "𝟬 ≡⇩e a<x>.P ⟹ False"
and "𝟬 ≡⇩e τ.(P) ⟹ False"
by(auto dest: sound)
lemma eq_eqvt:
fixes pi::"name prm"
and x::"'a::pt_name"
shows "pi∙(x=y) = ((pi∙x)=(pi∙y))"
by(simp add: perm_bool perm_bij)
nominal_primrec "depth" :: "pi ⇒ nat" where
"depth 𝟬 = 0"
| "depth (τ.(P)) = 1 + (depth P)"
| "a ♯ x ⟹ depth (a<x>.P) = 1 + (depth P)"
| "depth (a{b}.P) = 1 + (depth P)"
| "depth ([a⌢b]P) = (depth P)"
| "depth ([a≠b]P) = (depth P)"
| "depth (P ⊕ Q) = max (depth P) (depth Q)"
| "depth (P ∥ Q) = ((depth P) + (depth Q))"
| "depth (<νx>P) = (depth P)"
| "depth (!P) = (depth P)"
apply(auto simp add: fresh_nat)
apply(finite_guess)+
by(fresh_guess)+
lemma depthEqvt[simp]:
fixes P :: pi
and p :: "name prm"
shows "depth(p ∙ P) = depth P"
by(nominal_induct P rule: pi.strong_induct, auto simp add: name_bij)
lemma depthInput[simp]:
fixes a :: name
and x :: name
and P :: pi
shows "depth (a<x>.P) = 1 + (depth P)"
proof -
obtain y where yineqa: "y ≠ a" and yFreshP: "y ♯ P"
by(force intro: name_exists_fresh[of "(a, P)"] simp add: fresh_prod)
from yFreshP have "a<x>.P = a<y>.([(x, y)] ∙ P)" by(simp add: alphaInput)
with yineqa show ?thesis by simp
qed
nominal_primrec "valid" :: "pi ⇒ bool" where
"valid 𝟬 = True"
| "valid (τ.(P)) = valid P"
| "x ♯ a ⟹ valid (a<x>.P) = valid P"
| "valid (a{b}.P) = valid P"
| "valid ([a⌢b]P) = valid P"
| "valid ([a≠b]P) = valid P"
| "valid (P ⊕ Q) = ((valid P) ∧ (valid Q))"
| "valid (P ∥ Q) = ((valid P) ∧ (valid Q))"
| "valid (<νx>P) = valid P"
| "valid (!P) = False"
apply(auto simp add: fresh_bool)
apply(finite_guess)+
by(fresh_guess)+
lemma validEqvt[simp]:
fixes P :: pi
and p :: "name prm"
shows "valid(p ∙ P) = valid P"
by(nominal_induct P rule: pi.strong_induct, auto simp add: name_bij)
lemma validInput[simp]:
fixes a :: name
and x :: name
and P :: pi
shows "valid (a<x>.P) = valid P"
proof -
obtain y where yineqa: "y ≠ a" and yFreshP: "y ♯ P"
by(force intro: name_exists_fresh[of "(a, P)"] simp add: fresh_prod)
from yFreshP have "a<x>.P = a<y>.([(x, y)] ∙ P)" by(simp add: alphaInput)
with yineqa show ?thesis by simp
qed
lemma depthMin[intro]:
fixes P
shows "0 ≤ depth P"
by(induct P rule: pi.induct, auto)
lemma hnfTransition:
fixes P :: pi
assumes "hnf P"
and "P ≠ 𝟬"
shows "∃Rs. P ⟼ Rs"
using assms
by(induct rule: pi.induct, auto intro: Output Tau Input Sum1 Open)
definition "uhnf" :: "pi ⇒ bool" where
"uhnf P ≡ hnf P ∧ (∀R ∈ summands P. ∀R' ∈ summands P. R ≠ R' ⟶ ¬(R ≡⇩e R'))"
lemma summandsIdemp:
fixes P :: pi
and Q :: pi
assumes "Q ∈ summands P"
and "Q ≡⇩e Q'"
shows "P ⊕ Q' ≡⇩e P"
using assms
proof(nominal_induct P arbitrary: Q rule: pi.strong_inducts)
case(PiNil Q)
have "Q ∈ summands 𝟬" by fact
hence False by simp
thus ?case by simp
next
case(Output a b P Q)
have "Q ≡⇩e Q'" by fact
hence "a{b}.P ⊕ Q' ≡⇩e a{b}.P ⊕ Q" by(blast intro: SumPres' Refl Sym)
moreover have "Q = a{b}.P"
proof -
have "Q ∈ summands (a{b}.P)" by fact
thus ?thesis by simp
qed
ultimately show ?case by(blast intro: SumIdemp Trans)
next
case(Tau P Q)
have "Q ≡⇩e Q'" by fact
hence "τ.(P) ⊕ Q' ≡⇩e τ.(P) ⊕ Q" by(blast intro: SumPres' Refl Sym)
moreover have "Q = τ.(P)"
proof -
have "Q ∈ summands (τ.(P))" by fact
thus ?thesis by simp
qed
ultimately show ?case by(blast intro: SumIdemp Trans)
next
case(Input a x P Q)
have "Q ≡⇩e Q'" by fact
hence "a<x>.P ⊕ Q' ≡⇩e a<x>.P ⊕ Q" by(blast intro: SumPres' Refl Sym)
moreover have "Q = a<x>.P"
proof -
have "Q ∈ summands (a<x>.P)" by fact
thus ?thesis by simp
qed
ultimately show ?case by(blast intro: SumIdemp Trans)
next
case(Match a b P Q)
have "Q ∈ summands ([a⌢b]P)" by fact
hence False by simp
thus ?case by simp
next
case(Mismatch a b P Q)
have "Q ∈ summands ([a≠b]P)" by fact
hence False by simp
thus ?case by simp
next
case(Sum P Q R)
have IHP: "⋀P'. ⟦P' ∈ summands P; P' ≡⇩e Q'⟧ ⟹ P ⊕ Q' ≡⇩e P" by fact
have IHQ: "⋀Q''. ⟦Q'' ∈ summands Q; Q'' ≡⇩e Q'⟧ ⟹ Q ⊕ Q' ≡⇩e Q" by fact
have ReqQ': "R ≡⇩e Q'" by fact
have "R ∈ summands(P ⊕ Q)" by fact
hence "R ∈ summands P ∨ R ∈ summands Q" by simp
thus ?case
proof(rule disjE)
assume "R ∈ summands P"
hence PQ'eqP: "P ⊕ Q' ≡⇩e P" using ReqQ' by(rule IHP)
have "(P ⊕ Q) ⊕ Q' ≡⇩e P ⊕ (Q ⊕ Q')" by(rule SumAssoc)
moreover have "P ⊕ (Q ⊕ Q') ≡⇩e P ⊕ (Q' ⊕ Q)" by(blast intro: Refl SumSym SumPres')
moreover have "P ⊕ (Q' ⊕ Q) ≡⇩e (P ⊕ Q') ⊕ Q" by(blast intro: SumAssoc Sym)
moreover from PQ'eqP have "(P ⊕ Q') ⊕ Q ≡⇩e P ⊕ Q" by(blast intro: SumPres' Refl)
ultimately show ?case by(blast intro: Trans)
next
assume "R ∈ summands Q"
hence QQ'eqQ: "Q ⊕ Q' ≡⇩e Q" using ReqQ' by(rule IHQ)
have "(P ⊕ Q) ⊕ Q' ≡⇩e P ⊕ (Q ⊕ Q')" by(rule SumAssoc)
moreover from QQ'eqQ have "P ⊕ (Q ⊕ Q') ≡⇩e P ⊕ Q" by(blast intro: Refl SumPres')
ultimately show ?case by(rule Trans)
qed
next
case(Par P Q R)
have "R ∈ summands (P ∥ Q)" by fact
hence False by simp
thus ?case by simp
next
case(Res x P Q)
have "Q ≡⇩e Q'" by fact
hence "(<νx>P) ⊕ Q' ≡⇩e (<νx>P) ⊕ Q" by(blast intro: SumPres' Refl Sym)
moreover have "Q = <νx>P"
proof -
have "Q ∈ summands (<νx>P)" by fact
thus ?thesis by(auto simp add: if_split)
qed
ultimately show ?case by(blast intro: SumIdemp Trans)
next
case(Bang P Q)
have "Q ∈ summands(!P)" by fact
hence False by simp
thus ?case by simp
qed
lemma uhnfSum:
fixes P :: pi
and Q :: pi
assumes Phnf: "uhnf P"
and Qhnf: "uhnf Q"
and validP: "valid P"
and validQ: "valid Q"
shows "∃R. uhnf R ∧ valid R ∧ P ⊕ Q ≡⇩e R ∧ (depth R) ≤ (depth (P ⊕ Q))"
using assms
proof(nominal_induct P arbitrary: Q rule: pi.strong_inducts)
case(PiNil Q)
have "uhnf Q" by fact
moreover have "valid Q" by fact
moreover have "𝟬 ⊕ Q ≡⇩e Q" by(blast intro: SumZero SumSym Trans)
moreover have "depth Q ≤ depth(𝟬 ⊕ Q)" by auto
ultimately show ?case by blast
next
case(Output a b P Q)
show ?case
proof(case_tac "Q = 𝟬")
assume "Q = 𝟬"
moreover have "uhnf (a{b}.P)" by(simp add: uhnf_def)
moreover have "valid (a{b}.P)" by fact
moreover have "a{b}.P ⊕ 𝟬 ≡⇩e a{b}.P" by(rule SumZero)
moreover have "depth(a{b}.P) ≤ depth(a{b}.P ⊕ 𝟬)" by simp
ultimately show ?case by blast
next
assume QineqNil: "Q ≠ 𝟬"
have Qhnf: "uhnf Q" by fact
have validQ: "valid Q" by fact
have validP: "valid(a{b}.P)" by fact
show ?case
proof(case_tac "∃Q' ∈ summands Q. Q' ≡⇩e a{b}.P")
assume "∃Q' ∈ summands Q. Q' ≡⇩e a{b}.P"
then obtain Q' where "Q' ∈ summands Q" and "Q' ≡⇩e a{b}.P" by blast
hence "Q ⊕ a{b}.P ≡⇩e Q" by(rule summandsIdemp)
moreover have "depth Q ≤ depth(Q ⊕ a{b}.P)" by simp
ultimately show ?case using Qhnf validQ by(force intro: SumSym Trans)
next
assume "¬(∃Q' ∈ summands Q. Q' ≡⇩e a{b}.P)"
hence "∀Q' ∈ summands Q. ¬(Q' ≡⇩e a{b}.P)" by simp
with Qhnf QineqNil have "uhnf (a{b}.P ⊕ Q)"
by(force dest: Sym simp add: uhnf_def)
moreover from validQ validP have "valid(a{b}.P ⊕ Q)" by simp
moreover have "a{b}.P ⊕ Q ≡⇩e a{b}.P ⊕ Q" by(rule Refl)
moreover have "depth(a{b}.P ⊕ Q) ≤ depth(a{b}.P ⊕ Q)" by simp
ultimately show ?case by blast
qed
qed
next
case(Tau P Q)
show ?case
proof(case_tac "Q = 𝟬")
assume "Q = 𝟬"
moreover have "uhnf (τ.(P))" by(simp add: uhnf_def)
moreover have "valid (τ.(P))" by fact
moreover have "τ.(P) ⊕ 𝟬 ≡⇩e τ.(P)" by(rule SumZero)
moreover have "depth(τ.(P)) ≤ depth(τ.(P) ⊕ 𝟬)" by simp
ultimately show ?case by blast
next
assume QineqNil: "Q ≠ 𝟬"
have Qhnf: "uhnf Q" by fact
have validP: "valid(τ.(P))" and validQ: "valid Q" by fact+
show ?case
proof(case_tac "∃Q' ∈ summands Q. Q' ≡⇩e τ.(P)")
assume "∃Q' ∈ summands Q. Q' ≡⇩e τ.(P)"
then obtain Q' where "Q' ∈ summands Q" and "Q' ≡⇩e τ.(P)" by blast
hence "Q ⊕ τ.(P) ≡⇩e Q" by(rule summandsIdemp)
moreover have "depth Q ≤ depth(Q ⊕ τ.(P))" by simp
ultimately show ?case using Qhnf validQ by(force intro: SumSym Trans)
next
assume "¬(∃Q' ∈ summands Q. Q' ≡⇩e τ.(P))"
hence "∀Q' ∈ summands Q. ¬(Q' ≡⇩e τ.(P))" by simp
with Qhnf QineqNil have "uhnf (τ.(P) ⊕ Q)"
by(force dest: Sym simp add: uhnf_def)
moreover from validP validQ have "valid(τ.(P) ⊕ Q)" by simp
moreover have "τ.(P) ⊕ Q ≡⇩e τ.(P) ⊕ Q" by(rule Refl)
moreover have "depth(τ.(P) ⊕ Q) ≤ depth(τ.(P) ⊕ Q)" by simp
ultimately show ?case by blast
qed
qed
next
case(Input a x P Q)
show ?case
proof(case_tac "Q = 𝟬")
assume "Q = 𝟬"
moreover have "uhnf (a<x>.P)" by(simp add: uhnf_def)
moreover have "valid (a<x>.P)" by fact
moreover have "a<x>.P ⊕ 𝟬 ≡⇩e a<x>.P" by(rule SumZero)
moreover have "depth(a<x>.P) ≤ depth(a<x>.P ⊕ 𝟬)" by simp
ultimately show ?case by blast
next
assume QineqNil: "Q ≠ 𝟬"
have validP: "valid(a<x>.P)" and validQ: "valid Q" by fact+
have Qhnf: "uhnf Q" by fact
show ?case
proof(case_tac "∃Q' ∈ summands Q. Q' ≡⇩e a<x>.P")
assume "∃Q' ∈ summands Q. Q' ≡⇩e a<x>.P"
then obtain Q' where "Q' ∈ summands Q" and "Q' ≡⇩e a<x>.P" by blast
hence "Q ⊕ a<x>.P ≡⇩e Q" by(rule summandsIdemp)
moreover have "depth Q ≤ depth(Q ⊕ a<x>.P)" by simp
ultimately show ?case using Qhnf validQ by(force intro: SumSym Trans)
next
assume "¬(∃Q' ∈ summands Q. Q' ≡⇩e a<x>.P)"
hence "∀Q' ∈ summands Q. ¬(Q' ≡⇩e a<x>.P)" by simp
with Qhnf QineqNil have "uhnf (a<x>.P ⊕ Q)"
by(force dest: Sym simp add: uhnf_def)
moreover from validP validQ have "valid(a<x>.P ⊕ Q)" by simp
moreover have "a<x>.P ⊕ Q ≡⇩e a<x>.P ⊕ Q" by(rule Refl)
moreover have "depth(a<x>.P ⊕ Q) ≤ depth(a<x>.P ⊕ Q)" by simp
ultimately show ?case by blast
qed
qed
next
case(Match a b P Q)
have "uhnf ([a⌢b]P)" by fact
hence False by(simp add: uhnf_def)
thus ?case by simp
next
case(Mismatch a b P Q)
have "uhnf ([a≠b]P)" by fact
hence False by(simp add: uhnf_def)
thus ?case by simp
next
case(Sum P Q R)
have Rhnf: "uhnf R" by fact
have validR: "valid R" by fact
have PQhnf: "uhnf (P ⊕ Q)" by fact
have validPQ: "valid(P ⊕ Q)" by fact
have "∃T. uhnf T ∧ valid T ∧ Q ⊕ R ≡⇩e T ∧ depth T ≤ depth (Q ⊕ R)"
proof -
from PQhnf have "uhnf Q" by(simp add: uhnf_def)
moreover from validPQ have "valid Q" by simp+
moreover have "⋀R. ⟦uhnf Q; uhnf R; valid Q; valid R⟧ ⟹ ∃T. uhnf T ∧ valid T ∧ Q ⊕ R ≡⇩e T ∧ depth T ≤ depth(Q ⊕ R)" by fact
ultimately show ?thesis using Rhnf validR by blast
qed
then obtain T where Thnf: "uhnf T" and QReqT: "Q ⊕ R ≡⇩e T" and validT: "valid T"
and Tdepth: "depth T ≤ depth(Q ⊕ R)" by blast
have "∃S. uhnf S ∧ valid S ∧ P ⊕ T ≡⇩e S ∧ depth S ≤ depth(P ⊕ T)"
proof -
from PQhnf have "uhnf P" by(simp add: uhnf_def)
moreover from validPQ have "valid P" by simp
moreover have "⋀T. ⟦uhnf P; uhnf T; valid P; valid T⟧ ⟹ ∃S. uhnf S ∧ valid S ∧ P ⊕ T ≡⇩e S ∧ depth S ≤ depth(P ⊕ T)" by fact
ultimately show ?thesis using Thnf validT by blast
qed
then obtain S where Shnf: "uhnf S" and PTeqS: "P ⊕ T ≡⇩e S" and validS: "valid S"
and Sdepth: "depth S ≤ depth(P ⊕ T)" by blast
have "(P ⊕ Q) ⊕ R ≡⇩e S"
proof -
have "(P ⊕ Q) ⊕ R ≡⇩e P ⊕ (Q ⊕ R)" by(rule SumAssoc)
moreover from QReqT have "P ⊕ (Q ⊕ R) ≡⇩e P ⊕ T"
by(blast intro: Refl SumPres')
ultimately show ?thesis using PTeqS by(blast intro: Trans)
qed
moreover from Tdepth Sdepth have "depth S ≤ depth((P ⊕ Q) ⊕ R)" by auto
ultimately show ?case using Shnf validS by blast
next
case(Par P Q R)
have "uhnf (P ∥ Q)" by fact
hence False by(simp add: uhnf_def)
thus ?case by simp
next
case(Res x P Q)
show ?case
proof(case_tac "Q = 𝟬")
assume "Q = 𝟬"
moreover have "uhnf (<νx>P)" by fact
moreover have "valid (<νx>P)" by fact
moreover have "<νx>P ⊕ 𝟬 ≡⇩e <νx>P" by(rule SumZero)
moreover have "depth(<νx>P) ≤ depth((<νx>P) ⊕ 𝟬)" by simp
ultimately show ?case by blast
next
assume QineqNil: "Q ≠ 𝟬"
have Qhnf: "uhnf Q" by fact
have validP: "valid(<νx>P)" and validQ: "valid Q" by fact+
show ?case
proof(case_tac "∃Q' ∈ summands Q. Q' ≡⇩e <νx>P")
assume "∃Q' ∈ summands Q. Q' ≡⇩e <νx>P"
then obtain Q' where "Q' ∈ summands Q" and "Q' ≡⇩e <νx>P" by blast
hence "Q ⊕ <νx>P ≡⇩e Q" by(rule summandsIdemp)
moreover have "depth Q ≤ depth(Q ⊕ <νx>P)" by simp
ultimately show ?case using Qhnf validQ by(force intro: SumSym Trans)
next
assume "¬(∃Q' ∈ summands Q. Q' ≡⇩e <νx>P)"
hence "∀Q' ∈ summands Q. ¬(Q' ≡⇩e <νx>P)" by simp
moreover have "uhnf (<νx>P)" by fact
ultimately have "uhnf (<νx>P ⊕ Q)" using Qhnf QineqNil
by(force dest: Sym simp add: uhnf_def)
moreover from validP validQ have "valid(<νx>P ⊕ Q)" by simp
moreover have "(<νx>P) ⊕ Q ≡⇩e (<νx>P) ⊕ Q" by(rule Refl)
moreover have "depth((<νx>P) ⊕ Q) ≤ depth((<νx>P) ⊕ Q)" by simp
ultimately show ?case by blast
qed
qed
next
case(Bang P Q)
have "uhnf (!P)" by fact
hence False by(simp add: uhnf_def)
thus ?case by simp
qed
lemma uhnfRes:
fixes x :: name
and P :: pi
assumes Phnf: "uhnf P"
and validP: "valid P"
shows "∃P'. uhnf P' ∧ valid P' ∧ <νx>P ≡⇩e P' ∧ depth P' ≤ depth(<νx>P)"
using assms
proof(nominal_induct P avoiding: x rule: pi.strong_inducts)
case(PiNil x)
have "uhnf 𝟬" by(simp add: uhnf_def)
moreover have "valid 𝟬" by simp
moreover have "<νx>𝟬 ≡⇩e 𝟬" by(rule ResNil)
moreover have "depth 𝟬 ≤ depth(<νx>𝟬)" by simp
ultimately show ?case by blast
next
case(Output a b P)
have "valid(a{b}.P)" by fact
hence validP: "valid P" by simp
show ?case
proof(case_tac "x=a")
assume "x = a"
moreover have "uhnf 𝟬" by(simp add: uhnf_def)
moreover have "valid 𝟬" by simp
moreover have "𝟬 ≡⇩e <νx>x{b}.P" by(blast intro: ResOutput' Sym)
moreover have "depth 𝟬 ≤ depth(<νx>x{b}.P)" by simp
ultimately show ?case by(blast intro: Sym)
next
assume xineqa: "x ≠ a"
show ?case
proof(case_tac "x=b")
assume "x=b"
moreover from xineqa have "uhnf(<νx>a{x}.P)" by(force simp add: uhnf_def)
moreover from validP have "valid(<νx>a{x}.P)" by simp
moreover have "<νx>a{x}.P ≡⇩e <νx>a{x}.P" by(rule Refl)
moreover have "depth(<νx>a{x}.P) ≤ depth(<νx>a{x}.P)" by simp
ultimately show ?case by blast
next
assume xineqb: "x ≠ b"
have "uhnf(a{b}.(<νx>P))" by(simp add: uhnf_def)
moreover from validP have "valid(a{b}.(<νx>P))" by simp
moreover from xineqa xineqb have "a{b}.(<νx>P) ≡⇩e <νx>a{b}.P" by(blast intro: ResOutput Sym)
moreover have "depth(a{b}.(<νx>P)) ≤ depth(<νx>a{b}.P)" by simp
ultimately show ?case by(blast intro: Sym)
qed
qed
next
case(Tau P)
have "valid(τ.(P))" by fact
hence validP: "valid P" by simp
have "uhnf(τ.(<νx>P))" by(simp add: uhnf_def)
moreover from validP have "valid(τ.(<νx>P))" by simp
moreover have "τ.(<νx>P) ≡⇩e <νx>τ.(P)" by(blast intro: ResTau Sym)
moreover have "depth(τ.(<νx>P)) ≤ depth(<νx>τ.(P))" by simp
ultimately show ?case by(blast intro: Sym)
next
case(Input a y P x)
have "valid(a<y>.P)" by fact
hence validP: "valid P" by simp
have "y ♯ x" by fact hence yineqx: "y ≠ x" by simp
show ?case
proof(case_tac "x=a")
assume "x = a"
moreover have "uhnf 𝟬" by(simp add: uhnf_def)
moreover have "valid 𝟬" by simp
moreover have "𝟬 ≡⇩e <νx>x<y>.P" by(blast intro: ResInput' Sym)
moreover have "depth 𝟬 ≤ depth(<νx>x<y>.P)" by simp
ultimately show ?case by(blast intro: Sym)
next
assume xineqa: "x ≠ a"
have "uhnf(a<y>.(<νx>P))" by(simp add: uhnf_def)
moreover from validP have "valid(a<y>.(<νx>P))" by simp
moreover from xineqa yineqx have "a<y>.(<νx>P) ≡⇩e <νx>a<y>.P" by(blast intro: ResInput Sym)
moreover have "depth(a<y>.(<νx>P)) ≤ depth(<νx>a<y>.P)" by simp
ultimately show ?case by(blast intro: Sym)
qed
next
case(Match a b P x)
have "uhnf([a⌢b]P)" by fact
hence False by(simp add: uhnf_def)
thus ?case by simp
next
case(Mismatch a b P x)
have "uhnf([a≠b]P)" by fact
hence False by(simp add: uhnf_def)
thus ?case by simp
next
case(Sum P Q x)
have "valid(P ⊕ Q)" by fact
hence validP: "valid P" and validQ: "valid Q" by simp+
have "uhnf(P ⊕ Q)" by fact
hence Phnf: "uhnf P" and Qhnf: "uhnf Q" by(auto simp add: uhnf_def)
have "∃P'. uhnf P' ∧ valid P' ∧ P' ≡⇩e <νx>P ∧ (depth P') ≤ (depth(<νx>P))"
proof -
have "⟦uhnf P; valid P⟧ ⟹ ∃P'. uhnf P' ∧ valid P' ∧ <νx>P ≡⇩e P' ∧ (depth P') ≤ (depth (<νx>P))" by fact
with validP Phnf show ?thesis by(blast intro: Sym)
qed
then obtain P' where P'hnf: "uhnf P'" and P'eqP: "P' ≡⇩e <νx>P" and validP': "valid P'"
and P'depth: "(depth P') ≤ (depth(<νx>P))" by blast
have "∃Q'. uhnf Q' ∧ valid Q' ∧ Q' ≡⇩e <νx>Q ∧ (depth Q') ≤ (depth(<νx>Q))"
proof -
have "⟦uhnf Q; valid Q⟧ ⟹ ∃Q'. uhnf Q' ∧ valid Q' ∧ <νx>Q ≡⇩e Q' ∧ (depth Q') ≤ (depth(<νx>Q))" by fact
with validQ Qhnf show ?thesis by(blast intro: Sym)
qed
then obtain Q' where Q'hnf: "uhnf Q'" and Q'eqQ: "Q' ≡⇩e <νx>Q" and validQ': "valid Q'"
and Q'depth: "(depth Q') ≤ (depth(<νx>Q))" by blast
from P'hnf Q'hnf validP' validQ' obtain R where Rhnf: "uhnf R" and validR: "valid R"
and P'Q'eqR: "P' ⊕ Q' ≡⇩e R"
and Rdepth: "depth R ≤ depth(P' ⊕ Q')"
apply(drule_tac uhnfSum) apply assumption+ by blast
from P'eqP Q'eqQ P'Q'eqR have "<νx>(P ⊕ Q) ≡⇩e R" by(blast intro: Sym SumPres' SumRes Trans)
moreover from Rdepth P'depth Q'depth have "depth R ≤ depth(<νx>(P ⊕ Q))" by auto
ultimately show ?case using validR Rhnf by(blast intro: Sym)
next
case(Par P Q)
have "uhnf(P ∥ Q)" by fact
hence False by(simp add: uhnf_def)
thus ?case by simp
next
case(Res y P x)
have "valid(<νy>P)" by fact hence validP: "valid P" by simp
have "uhnf(<νy>P)" by fact
then obtain a P' where aineqy: "a ≠ y" and PeqP': "P = a{y}.P'"
by(force simp add: uhnf_def)
show ?case
proof(case_tac "x=y")
assume "x=y"
moreover from aineqy have "uhnf(<νy>a{y}.P')" by(force simp add: uhnf_def)
moreover from validP PeqP' have "valid(<νy>a{y}.P')" by simp
moreover have "<νy><νy>a{y}.P' ≡⇩e <νy>a{y}.P'"
proof -
have "y ♯ <νy>a{y}.P'" by(simp add: name_fresh_abs)
hence "<νy><νy>a{y}.P' ≡⇩e <νy>a{y}.P'" by(rule ResFresh)
thus ?thesis by(blast intro: Trans)
qed
moreover have "depth(<νy>a{y}.P') ≤ depth(<νy><νy>a{y}.P')" by simp
ultimately show ?case using PeqP' by blast
next
assume xineqy: "x≠y"
show ?case
proof(case_tac "x=a")
assume "x=a"
moreover have "uhnf 𝟬" by(simp add: uhnf_def)
moreover have "valid 𝟬" by simp
moreover have "<νa><νy>a{y}.P' ≡⇩e 𝟬"
proof -
have "<νa><νy>a{y}.P' ≡⇩e <νy><νa>a{y}.P'" by(rule ResComm)
moreover have "<νy><νa>a{y}.P' ≡⇩e 𝟬"
by(blast intro: ResOutput' ResNil ResPres Trans)
ultimately show ?thesis by(blast intro: Trans)
qed
moreover have "depth 𝟬 ≤ depth(<νa><νy>a{y}.P')" by simp
ultimately show ?case using PeqP' by blast
next
assume xineqa: "x ≠ a"
from aineqy have "uhnf(<νy>a{y}.(<νx>P'))" by(force simp add: uhnf_def)
moreover from validP PeqP' have "valid(<νy>a{y}.(<νx>P'))" by simp
moreover have "<νx><νy>a{y}.P' ≡⇩e <νy>a{y}.(<νx>P')"
proof -
have "<νx><νy>a{y}.P' ≡⇩e <νy><νx>a{y}.P'" by(rule ResComm)
moreover from xineqa xineqy have "<νy><νx>a{y}.P' ≡⇩e <νy>a{y}.(<νx>P')"
by(blast intro: ResOutput ResPres Trans)
ultimately show ?thesis by(blast intro: Trans)
qed
moreover have "depth(<νy>a{y}.(<νx>P')) ≤ depth(<νx><νy>a{y}.P')"
by simp
ultimately show ?case using PeqP' by blast
qed
qed
next
case(Bang P x)
have "valid(!P)" by fact
hence False by simp
thus ?case by simp
qed
lemma expandHnf:
fixes P :: pi
and S :: "pi set"
assumes "(P, S) ∈ sumComposeSet"
and "∀P ∈ S. uhnf P ∧ valid P"
shows "∃P'. uhnf P' ∧ valid P' ∧ P ≡⇩e P' ∧ depth P' ≤ depth P"
using assms
proof(induct rule: sumComposeSet.induct)
case empty
have "uhnf 𝟬" by(simp add: uhnf_def)
moreover have "valid 𝟬" by simp
moreover have "𝟬 ≡⇩e 𝟬" by(rule Refl)
moreover have "depth 𝟬 ≤ depth 𝟬" by simp
ultimately show ?case by blast
next
case(insert Q S P)
have Shnf: "∀P ∈ S. uhnf P ∧ valid P" by fact
hence "∀P ∈ (S - {(Q)}). uhnf P ∧ valid P" by simp
moreover have "∀P ∈ (S - {(Q)}). uhnf P ∧ valid P ⟹ ∃P'. uhnf P' ∧ valid P' ∧ P ≡⇩e P' ∧ depth P' ≤ depth P" by fact
ultimately obtain P' where P'hnf: "uhnf P'" and validP': "valid P'"
and PeqP': "P ≡⇩e P'" and PP'depth: "depth P' ≤ depth P"
by blast
have "Q ∈ S" by fact
with Shnf have "uhnf Q" and "valid Q" by simp+
with P'hnf validP' obtain R where Rhnf: "uhnf R" and validR: "valid R"
and P'QeqR: "P' ⊕ Q ≡⇩e R" and P'QRdepth: "depth R ≤ depth (P' ⊕ Q)"
by(auto dest: uhnfSum)
from PeqP' P'QeqR have "P ⊕ Q ≡⇩e R" by(blast intro: SumPres Trans)
moreover from PP'depth P'QRdepth have "depth R ≤ depth(P ⊕ Q)" by simp
ultimately show ?case using Rhnf validR by blast
qed
lemma hnfSummandsRemove:
fixes P :: pi
and Q :: pi
assumes "P ∈ summands Q"
and "uhnf Q"
shows "(summands Q) - {P' | P'. P' ∈ summands Q ∧ P' ≡⇩e P} = (summands Q) - {P}"
using assms
by(auto intro: Refl simp add: uhnf_def)
lemma pullSummand:
fixes P :: pi
and Q :: pi
assumes PsummQ: "P ∈ summands Q"
and Qhnf: "uhnf Q"
shows "∃Q'. P ⊕ Q' ≡⇩e Q ∧ (summands Q') = ((summands Q) - {x. ∃P'. x = P' ∧ P' ∈ (summands Q) ∧ P' ≡⇩e P}) ∧ uhnf Q'"
proof -
have SumGoal: "⋀P Q R. ⟦P ∈ summands Q; uhnf(Q ⊕ R);
⋀P. ⟦P ∈ summands Q⟧ ⟹ ∃Q'. P ⊕ Q' ≡⇩e Q ∧
(summands Q') = ((summands Q) - {P' |P'. P' ∈ summands Q ∧ P' ≡⇩e P}) ∧ uhnf Q';
⋀P. ⟦P ∈ summands R⟧ ⟹ ∃R'. P ⊕ R' ≡⇩e R ∧
(summands R') = ((summands R) - {P' |P'. P' ∈ summands R ∧ P' ≡⇩e P}) ∧ uhnf R'⟧
⟹ ∃Q'. P ⊕ Q' ≡⇩e Q ⊕ R ∧
summands Q' = summands (pi.Sum Q R) - {P' |P'. P' ∈ summands (Q ⊕ R) ∧ P' ≡⇩e P} ∧ uhnf Q'"
proof -
fix P Q R
assume IHR: "⋀P. P ∈ summands R ⟹ ∃R'. P ⊕ R' ≡⇩e R ∧
(summands R') = ((summands R) - {P' |P'. P' ∈ summands R ∧ P' ≡⇩e P}) ∧ uhnf R'"
assume PsummQ: "P ∈ summands Q"
moreover assume "⋀P. P ∈ summands Q ⟹ ∃Q'. P ⊕ Q' ≡⇩e Q ∧
(summands Q') = ((summands Q) - {P' |P'. P' ∈ summands Q ∧ P' ≡⇩e P}) ∧ uhnf Q'"
ultimately obtain Q' where PQ'eqQ: "P ⊕ Q' ≡⇩e Q"
and Q'summQ: "(summands Q') = ((summands Q) - {P' |P'. P' ∈ summands Q ∧ P' ≡⇩e P})"
and Q'hnf: "uhnf Q'"
by blast
assume QRhnf: "uhnf(Q ⊕ R)"
show "∃Q'. P ⊕ Q' ≡⇩e Q ⊕ R ∧
summands Q' = summands (pi.Sum Q R) - {P' |P'. P' ∈ summands (Q ⊕ R) ∧ P' ≡⇩e P} ∧ uhnf Q'"
proof(cases "∃P' ∈ summands R. P' ≡⇩e P")
assume "∃P' ∈ summands R. P' ≡⇩e P"
then obtain P' where P'summR: "P' ∈ summands R" and P'eqP: "P' ≡⇩e P" by blast
with IHR obtain R' where PR'eqR: "P' ⊕ R' ≡⇩e R"
and R'summR: "(summands R') = ((summands R) - {P'' |P''. P'' ∈ summands R ∧ P'' ≡⇩e P'})"
and R'hnf: "uhnf R'"
by blast
have L1: "P ⊕ (Q' ⊕ R') ≡⇩e Q ⊕ R"
proof -
from P'eqP have "P ⊕ (Q' ⊕ R') ≡⇩e (P ⊕ P') ⊕ (Q' ⊕ R')"
by(blast intro: SumIdemp' SumPres Sym)
moreover have "(P ⊕ P') ⊕ (Q' ⊕ R') ≡⇩e P ⊕ (P' ⊕ (Q' ⊕ R'))" by(rule SumAssoc)
moreover have "P ⊕ (P' ⊕ (Q' ⊕ R')) ≡⇩e P ⊕ (P' ⊕ (R' ⊕ Q'))"
by(blast intro: Refl SumPres' SumSym)
moreover have "P ⊕ (P' ⊕ (R' ⊕ Q')) ≡⇩e P ⊕ (P' ⊕ R') ⊕ Q'"
by(blast intro: Refl SumPres' Sym SumAssoc)
moreover have "P ⊕ (P' ⊕ R') ⊕ Q' ≡⇩e (P ⊕ Q') ⊕ (P' ⊕ R')"
proof -
have "P ⊕ (P' ⊕ R') ⊕ Q' ≡⇩e P ⊕ Q' ⊕ (P' ⊕ R')"
by(blast intro: Refl SumPres' SumSym)
thus ?thesis by(blast intro: Sym SumAssoc Trans)
qed
moreover from PQ'eqQ PR'eqR have "(P ⊕ Q') ⊕ (P' ⊕ R') ≡⇩e Q ⊕ R" by(rule SumPres')
ultimately show ?thesis by(blast intro!: Trans)
qed
show ?thesis
proof(cases "Q' = 𝟬")
assume Q'eqNil: "Q' = 𝟬"
have "P ⊕ R' ≡⇩e Q ⊕ R"
proof -
have "P ⊕ R' ≡⇩e P ⊕ (R' ⊕ 𝟬)" by(blast intro: SumZero Refl Trans SumPres' Sym)
moreover have "P ⊕ (R' ⊕ 𝟬) ≡⇩e P ⊕ (𝟬 ⊕ R')"
by(blast intro: SumSym Trans SumPres' Refl)
ultimately show ?thesis using L1 Q'eqNil by(blast intro: Trans)
qed
moreover from R'summR Q'summQ P'eqP Q'eqNil have "summands (R') = (summands (Q ⊕ R) - {P' |P'. P' ∈ summands(Q ⊕ R) ∧ P' ≡⇩e P})"
by(auto intro: Sym Trans)
ultimately show ?thesis using R'hnf by blast
next
assume Q'ineqNil: "Q' ≠ 𝟬"
show ?thesis
proof(case_tac "R' = 𝟬")
assume R'eqNil: "R' = 𝟬"
have "P ⊕ Q' ≡⇩e Q ⊕ R"
proof -
have "P ⊕ Q' ≡⇩e P ⊕ (Q' ⊕ 𝟬)" by(blast intro: SumZero Refl Trans SumPres' Sym)
with L1 R'eqNil show ?thesis by(blast intro: Trans)
qed
moreover from R'summR Q'summQ P'eqP R'eqNil have "summands (Q') = (summands (Q ⊕ R) - {P' |P'. P' ∈ summands(Q ⊕ R) ∧ P' ≡⇩e P})"
by(auto intro: Sym Trans)
ultimately show ?thesis using Q'hnf by blast
next
assume R'ineqNil: "R' ≠ 𝟬"
from R'summR Q'summQ P'eqP have "summands (Q' ⊕ R') = (summands (Q ⊕ R) - {P' |P'. P' ∈ summands(Q ⊕ R) ∧ P' ≡⇩e P})"
by(auto intro: Sym Trans)
moreover from QRhnf Q'hnf R'hnf R'summR Q'summQ Q'ineqNil R'ineqNil have "uhnf(Q' ⊕ R')"
by(auto simp add: uhnf_def)
ultimately show ?thesis using L1 by blast
qed
qed
next
assume "¬(∃P' ∈ summands R. P' ≡⇩e P)"
hence Case: "∀P' ∈ summands R. ¬(P' ≡⇩e P)" by simp
show ?thesis
proof(case_tac "Q' = 𝟬")
assume Q'eqNil: "Q' = 𝟬"
have "P ⊕ R ≡⇩e Q ⊕ R"
proof -
have "P ⊕ R ≡⇩e (P ⊕ 𝟬) ⊕ R" by(blast intro: SumZero Sym Trans SumPres)
moreover from PQ'eqQ have "P ⊕ (Q' ⊕ R) ≡⇩e Q ⊕ R"
by(blast intro: SumAssoc Trans Sym SumPres)
ultimately show ?thesis using Q'eqNil by(blast intro: SumAssoc Trans)
qed
moreover from Q'summQ Q'eqNil Case have "summands (R) = (summands (Q ⊕ R) - {P' |P'. P' ∈ summands(Q ⊕ R) ∧ P' ≡⇩e P})"
by auto
moreover from QRhnf have "uhnf R" by(simp add: uhnf_def)
ultimately show ?thesis by blast
next
assume Q'ineqNil: "Q' ≠ 𝟬"
from PQ'eqQ have "P ⊕ (Q' ⊕ R) ≡⇩e Q ⊕ R"
by(blast intro: SumAssoc Trans Sym SumPres)
moreover from Q'summQ Case have "summands (Q' ⊕ R) = (summands (Q ⊕ R) - {P' |P'. P' ∈ summands(Q ⊕ R) ∧ P' ≡⇩e P})"
by auto
moreover from QRhnf Q'hnf Q'summQ Q'ineqNil have "uhnf (Q' ⊕ R)"
by(auto simp add: uhnf_def)
ultimately show ?thesis by blast
qed
qed
qed
from assms show ?thesis
proof(nominal_induct Q arbitrary: P rule: pi.strong_inducts)
case PiNil
have "P ∈ summands 𝟬" by fact
hence False by auto
thus ?case by simp
next
case(Output a b Q)
have "P ∈ summands (a{b}.Q)" by fact
hence PeqQ: "P = a{b}.Q" by simp
have "P ⊕ 𝟬 ≡⇩e a{b}.Q"
proof -
have "P ⊕ 𝟬 ≡⇩e P" by(rule SumZero)
with PeqQ show ?thesis by simp
qed
moreover have "(summands 𝟬) = (summands (a{b}.Q)) - {P' | P'. P' ∈ summands (a{b}.Q) ∧ P' ≡⇩e P}"
proof -
have "a{b}.Q ≡⇩e a{b}.Q" by(rule Refl)
with PeqQ show ?thesis by simp
qed
moreover have "uhnf 𝟬" by(simp add: uhnf_def)
ultimately show ?case by blast
next
case(Tau Q)
have "P ∈ summands (τ.(Q))" by fact
hence PeqQ: "P = τ.(Q)" by simp
have "P ⊕ 𝟬 ≡⇩e τ.(Q)"
proof -
have "P ⊕ 𝟬 ≡⇩e P" by(rule SumZero)
with PeqQ show ?thesis by simp
qed
moreover have "(summands 𝟬) = (summands (τ.(Q))) - {P' | P'. P' ∈ summands (τ.(Q)) ∧ P' ≡⇩e P}"
proof -
have "τ.(Q) ≡⇩e τ.(Q)" by(rule Refl)
with PeqQ show ?thesis by simp
qed
moreover have "uhnf 𝟬" by(simp add: uhnf_def)
ultimately show ?case by blast
next
case(Input a x Q)
have "P ∈ summands (a<x>.Q)" by fact
hence PeqQ: "P = a<x>.Q" by simp
have "P ⊕ 𝟬 ≡⇩e a<x>.Q"
proof -
have "P ⊕ 𝟬 ≡⇩e P" by(rule SumZero)
with PeqQ show ?thesis by simp
qed
moreover have "(summands 𝟬) = (summands (a<x>.Q)) - {P' | P'. P' ∈ summands (a<x>.Q) ∧ P' ≡⇩e P}"
proof -
have "a<x>.Q ≡⇩e a<x>.Q" by(rule Refl)
with PeqQ show ?thesis by simp
qed
moreover have "uhnf 𝟬" by(simp add: uhnf_def)
ultimately show ?case by blast
next
case(Match a b Q)
have "P ∈ summands ([a⌢b]Q)" by fact
hence False by simp
thus ?case by simp
next
case(Mismatch a b Q)
have "P ∈ summands ([a≠b]Q)" by fact
hence False by simp
thus ?case by simp
next
case(Sum Q R)
have QRhnf: "uhnf (Q ⊕ R)" by fact
hence Qhnf: "uhnf Q" and Rhnf: "uhnf R" by(simp add: uhnf_def)+
have "⋀P. ⟦P ∈ summands Q; uhnf Q⟧ ⟹ ∃Q'. P ⊕ Q' ≡⇩e Q ∧
(summands Q') = ((summands Q) - {P' |P'. P' ∈ summands Q ∧ P' ≡⇩e P}) ∧ uhnf Q'"
by fact
with Qhnf have IHQ: "⋀P. P ∈ summands Q ⟹ ∃Q'. P ⊕ Q' ≡⇩e Q ∧
(summands Q') = ((summands Q) - {P' |P'. P' ∈ summands Q ∧ P' ≡⇩e P}) ∧ uhnf Q'"
by simp
have "⋀P. ⟦P ∈ summands R; uhnf R⟧ ⟹ ∃R'. P ⊕ R' ≡⇩e R ∧
(summands R') = ((summands R) - {P' |P'. P' ∈ summands R ∧ P' ≡⇩e P}) ∧ uhnf R'"
by fact
with Rhnf have IHR: "⋀P. P ∈ summands R ⟹ ∃R'. P ⊕ R' ≡⇩e R ∧
(summands R') = ((summands R) - {P' |P'. P' ∈ summands R ∧ P' ≡⇩e P}) ∧ uhnf R'"
by simp
have "P ∈ summands (Q ⊕ R)" by fact
hence "P ∈ summands Q ∨ P ∈ summands R" by simp
thus ?case
proof(rule disjE)
assume "P ∈ summands Q"
thus ?case using QRhnf IHQ IHR by(rule SumGoal)
next
assume "P ∈ summands R"
moreover from QRhnf have "uhnf (R ⊕ Q)" by(auto simp add: uhnf_def)
ultimately have "∃Q'. (pi.Sum P Q') ≡⇩e (pi.Sum R Q) ∧
summands Q' = summands (pi.Sum R Q) - {P' |P'. P' ∈ summands (pi.Sum R Q) ∧ P' ≡⇩e P} ∧ uhnf Q'" using IHR IHQ
by(rule SumGoal)
thus ?case
by(force intro: SumSym Trans)
qed
next
case(Par Q R P)
have "P ∈ summands (Q ∥ R)" by fact
hence False by simp
thus ?case by simp
next
case(Res x Q P)
have "P ∈ summands (<νx>Q)" by fact
hence PeqQ: "P = <νx>Q" by(simp add: if_split)
have "P ⊕ 𝟬 ≡⇩e <νx>Q"
proof -
have "P ⊕ 𝟬 ≡⇩e P" by(rule SumZero)
with PeqQ show ?thesis by simp
qed
moreover have "(summands 𝟬) = (summands (<νx>Q)) - {P' | P'. P' ∈ summands (<νx>Q) ∧ P' ≡⇩e P}"
proof -
have "<νx>Q ≡⇩e <νx>Q" by(rule Refl)
with PeqQ show ?thesis by simp
qed
moreover have "uhnf 𝟬" by(simp add: uhnf_def)
ultimately show ?case by blast
next
case(Bang Q P)
have "P ∈ summands (!Q)" by fact
hence False by simp
thus ?case by simp
qed
qed
lemma nSym:
fixes P :: pi
and Q :: pi
assumes "¬(P ≡⇩e Q)"
shows "¬(Q ≡⇩e P)"
using assms
by(blast dest: Sym)
lemma summandsZero:
fixes P :: pi
assumes "summands P = {}"
and "hnf P"
shows "P = 𝟬"
using assms
by(nominal_induct P rule: pi.strong_inducts, auto intro: Refl SumIdemp SumPres' Trans)
lemma summandsZero':
fixes P :: pi
assumes summP: "summands P = {}"
and Puhnf: "uhnf P"
shows "P = 𝟬"
proof -
from Puhnf have "hnf P" by(simp add: uhnf_def)
with summP show ?thesis by(rule summandsZero)
qed
lemma summandEquiv:
fixes P :: pi
and Q :: pi
assumes Phnf: "uhnf P"
and Qhnf: "uhnf Q"
and PinQ: "∀P' ∈ summands P. ∃Q' ∈ summands Q. P' ≡⇩e Q'"
and QinP: "∀Q' ∈ summands Q. ∃P' ∈ summands P. Q' ≡⇩e P'"
shows "P ≡⇩e Q"
proof -
from finiteSummands assms show ?thesis
proof(induct F=="summands P" arbitrary: P Q rule: finite_induct)
case(empty P Q)
have PEmpty: "{} = summands P" by fact
moreover have "∀Q'∈summands Q. ∃P'∈summands P. Q' ≡⇩e P'" by fact
ultimately have QEmpty: "summands Q = {}" by simp
have "P = 𝟬"
proof -
have "uhnf P" by fact
with PEmpty show ?thesis by(blast intro: summandsZero')
qed
moreover have "Q = 𝟬"
proof -
have "uhnf Q" by fact
with QEmpty show ?thesis by(blast intro: summandsZero')
qed
ultimately show ?case by(blast intro: Refl)
next
case(insert P' F P Q)
have Phnf: "uhnf P" by fact
have Qhnf: "uhnf Q" by fact
have IH: "⋀P Q. ⟦F = summands P; uhnf P; uhnf Q; ∀P' ∈ summands P. ∃Q' ∈ summands Q. P' ≡⇩e Q';
∀Q' ∈ summands Q. ∃P' ∈ summands P. Q' ≡⇩e P'⟧ ⟹ P ≡⇩e Q"
by fact
have PeqQ: "∀P' ∈ summands P. ∃Q' ∈ summands Q. P' ≡⇩e Q'" by fact
have QeqP: "∀Q' ∈ summands Q. ∃P' ∈ summands P. Q' ≡⇩e P'" by fact
have PSumm: "insert P' F = summands P" by fact
hence P'SummP: "P' ∈ summands P" by auto
with Phnf obtain P'' where P'P''eqP: "P' ⊕ P'' ≡⇩e P"
and P''Summ: "summands P'' = summands P - {P'' |P''. P'' ∈ summands P ∧ P'' ≡⇩e P'}"
and P''hnf: "uhnf P''"
by(blast dest: pullSummand)
from PeqQ P'SummP obtain Q' where Q'SummQ: "Q' ∈ summands Q" and P'eqQ': "P' ≡⇩e Q'" by blast
from Q'SummQ Qhnf obtain Q'' where Q'Q''eqQ: "Q' ⊕ Q'' ≡⇩e Q"
and Q''Summ: "summands Q'' = summands Q - {Q'' |Q''. Q'' ∈ summands Q ∧ Q'' ≡⇩e Q'}"
and Q''hnf: "uhnf Q''"
by(blast dest: pullSummand)
have FeqP'': "F = summands P''"
proof -
have "P' ∉ F" by fact
with P''Summ PSumm hnfSummandsRemove[OF P'SummP Phnf] show ?thesis by blast
qed
moreover have "∀P' ∈ summands P''. ∃Q' ∈ summands Q''. P' ≡⇩e Q'"
proof(rule ballI)
fix P'''
assume P'''Summ: "P''' ∈ summands P''"
with P''Summ have "P''' ∈ summands P" by simp
with PeqQ obtain Q''' where Q'''Summ: "Q''' ∈ summands Q" and P'''eqQ''': "P''' ≡⇩e Q'''" by blast
have "Q''' ∈ summands Q''"
proof -
from P'''Summ P''Summ have "¬(P''' ≡⇩e P')" by simp
with P'eqQ' P'''eqQ''' have "¬(Q''' ≡⇩e Q')" by(blast intro: Trans Sym)
with Q''Summ Q'''Summ show ?thesis by simp
qed
with P'''eqQ''' show "∃Q'∈summands Q''. P''' ≡⇩e Q'" by blast
qed
moreover have "∀Q' ∈ summands Q''. ∃P' ∈ summands P''. Q' ≡⇩e P'"
proof(rule ballI)
fix Q'''
assume Q'''Summ: "Q''' ∈ summands Q''"
with Q''Summ have "Q''' ∈ summands Q" by simp
with QeqP obtain P''' where P'''Summ: "P''' ∈ summands P"
and Q'''eqP''': "Q''' ≡⇩e P'''" by blast
have "P''' ∈ summands P''"
proof -
from Q'''Summ Q''Summ have "¬(Q''' ≡⇩e Q')" by simp
with P'eqQ' Q'''eqP''' have "¬(P''' ≡⇩e P')" by(blast intro: Trans)
with P''Summ P'''Summ show ?thesis by simp
qed
with Q'''eqP''' show "∃P'∈summands P''. Q''' ≡⇩e P'" by blast
qed
ultimately have P''eqQ'': "P'' ≡⇩e Q''" using P''hnf Q''hnf by(rule_tac IH)
from P'P''eqP have "P ≡⇩e P' ⊕ P''" by(rule Sym)
moreover from P'eqQ' P''eqQ'' have "P' ⊕ P'' ≡⇩e Q' ⊕ Q''" by(rule SumPres')
ultimately show ?case using Q'Q''eqQ by(blast intro: Trans)
qed
qed
lemma validSubst[simp]:
fixes P :: pi
and a :: name
and b :: name
and p :: pi
shows "valid(P[a::=b]) = valid P"
by(nominal_induct P avoiding: a b rule: pi.strong_inducts, auto)
lemma validOutputTransition:
fixes P :: pi
and a :: name
and b :: name
and P' :: pi
assumes "P ⟼a[b] ≺ P'"
and "valid P"
shows "valid P'"
using assms
by(nominal_induct rule: outputInduct, auto)
lemma validInputTransition:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
assumes PTrans: "P ⟼a<x> ≺ P'"
and validP: "valid P"
shows "valid P'"
proof -
have Goal: "⋀P a x P'. ⟦P ⟼a<x> ≺ P'; x ♯ P; valid P⟧ ⟹ valid P'"
proof -
fix P a x P'
assume "P ⟼a<x> ≺ P'" and "x ♯ P" and "valid P"
thus "valid P'"
by(nominal_induct rule: inputInduct, auto)
qed
obtain y::name where yFreshP: "y ♯ P" and yFreshP': "y ♯ P'"
by(rule_tac name_exists_fresh[of "(P, P')"], auto simp add: fresh_prod)
from yFreshP' PTrans have "P ⟼a<y> ≺ [(x, y)] ∙ P'" by(simp add: alphaBoundResidual)
hence "valid ([(x, y)] ∙ P')" using yFreshP validP by(rule Goal)
thus "valid P'" by simp
qed
lemma validBoundOutputTransition:
fixes P :: pi
and a :: name
and x :: name
and P' :: pi
assumes PTrans: "P ⟼a<νx> ≺ P'"
and validP: "valid P"
shows "valid P'"
proof -
have Goal: "⋀P a x P'. ⟦P ⟼a<νx> ≺ P'; x ♯ P; valid P⟧ ⟹ valid P'"
proof -
fix P a x P'
assume "P ⟼a<νx> ≺ P'" and "x ♯ P" and "valid P"
thus "valid P'"
apply(nominal_induct rule: boundOutputInduct, auto)
proof -
fix P a x P'
assume "P ⟼(a::name)[x] ≺ P'" and "valid P"
thus "valid P'"
by(nominal_induct rule: outputInduct, auto)
qed
qed
obtain y::name where yFreshP: "y ♯ P" and yFreshP': "y ♯ P'"
by(rule_tac name_exists_fresh[of "(P, P')"], auto simp add: fresh_prod)
from yFreshP' PTrans have "P ⟼a<νy> ≺ [(x, y)] ∙ P'" by(simp add: alphaBoundResidual)
hence "valid ([(x, y)] ∙ P')" using yFreshP validP by(rule Goal)
thus "valid P'" by simp
qed
lemma validTauTransition:
fixes P :: pi
and P' :: pi
assumes PTrans: "P ⟼τ ≺ P'"
and validP: "valid P"
shows "valid P'"
using assms
by(nominal_induct rule: tauInduct, auto dest: validOutputTransition validInputTransition validBoundOutputTransition)
lemmas validTransition = validInputTransition validOutputTransition validTauTransition validBoundOutputTransition
lemma validSummand:
fixes P :: pi
and P' :: pi
and a :: name
and b :: name
and x :: name
assumes "valid P"
and "hnf P"
shows "τ.(P') ∈ summands P ⟹ valid P'"
and "a{b}.P' ∈ summands P ⟹ valid P'"
and "a<x>.P' ∈ summands P ⟹ valid P'"
and "⟦a ≠ x; <νx>a{x}.P' ∈ summands P⟧ ⟹ valid P'"
proof -
assume "τ.(P') ∈ summands P"
with assms show "valid P'" by(force intro: validTauTransition simp add: summandTransition)
next
assume "a{b}.P' ∈ summands P"
with assms show "valid P'" by(force intro: validOutputTransition simp add: summandTransition)
next
assume "a<x>.P' ∈ summands P"
with assms show "valid P'" by(force intro: validInputTransition simp add: summandTransition)
next
assume "<νx>a{x}.P' ∈ summands P" and "a ≠ x"
with assms show "valid P'"
by(force intro: validBoundOutputTransition simp add: summandTransition[THEN sym])
qed
lemma validExpand:
fixes P :: pi
and Q :: pi
assumes "valid P"
and "valid Q"
and "uhnf P"
and "uhnf Q"
shows "∀R ∈ (expandSet P Q). uhnf R ∧ valid R"
proof -
from assms have "hnf P" and "hnf Q" by(simp add: uhnf_def)+
with assms show ?thesis
apply(auto simp add: expandSet_def)
apply(force dest: validSummand simp add: uhnf_def)
apply(force dest: validSummand)
apply(force dest: validSummand simp add: uhnf_def)
apply(force dest: validSummand)
apply(force dest: validSummand simp add: uhnf_def)
apply(force dest: validSummand)
apply(force dest: validSummand simp add: uhnf_def)
apply(force dest: validSummand)
apply(force dest: validSummand simp add: uhnf_def)
apply(force dest: validSummand)
apply(force dest: validSummand simp add: uhnf_def)
apply(force dest: validSummand)
apply(subgoal_tac "a≠x")
apply(force dest: validSummand simp add: uhnf_def)
apply blast
apply(subgoal_tac "a≠x")
apply(drule_tac validSummand(4)) apply assumption+
apply blast
apply(subgoal_tac "a≠x")
apply(drule_tac validSummand(4)[where P=Q]) apply assumption+
apply(force dest: validSummand simp add: uhnf_def)
apply blast
apply(subgoal_tac "a≠x")
apply(drule_tac validSummand(4)[where P=Q]) apply assumption+
apply blast
apply(force dest: validSummand simp add: uhnf_def)
apply(force dest: validSummand)
apply(force dest: validSummand simp add: uhnf_def)
apply(force simp add: uhnf_def)
apply(force dest: validSummand)
apply(force dest: validSummand)
apply(force simp add: uhnf_def)
apply(force dest: validSummand)
apply(subgoal_tac "a≠y")
apply(drule_tac validSummand(4)[where P=Q]) apply assumption+
apply blast
apply(force dest: validSummand simp add: uhnf_def)
apply(subgoal_tac "a≠y")
apply(drule_tac validSummand(4)) apply assumption+
apply blast
by(force dest: validSummand)
qed
lemma expandComplete:
fixes F :: "pi set"
assumes "finite F"
shows "∃P. (P, F) ∈ sumComposeSet"
using assms
proof(induct F rule: finite_induct)
case empty
have "(𝟬, {}) ∈ sumComposeSet" by(rule sumComposeSet.empty)
thus ?case by blast
next
case(insert Q F)
have "∃P. (P, F) ∈ sumComposeSet" by fact
then obtain P where "(P, F) ∈ sumComposeSet" by blast
moreover have "Q ∈ insert Q F" by simp
moreover have "Q ∉ F" by fact
ultimately have "(P ⊕ Q, insert Q F) ∈ sumComposeSet"
by(force intro: sumComposeSet.insert)
thus ?case by blast
qed
lemma expandDepth:
fixes F :: "pi set"
and P :: pi
and Q :: pi
assumes "(P, F) ∈ sumComposeSet"
and "F ≠ {}"
shows "∃Q ∈ F. depth P ≤ depth Q ∧ (∀R ∈ F. depth R ≤ depth Q)"
using assms
proof(induct arbitrary: Q rule: sumComposeSet.induct)
case empty
have "({}::pi set) ≠ {}" by fact
hence False by simp
thus ?case by simp
next
case(insert Q S P)
have QinS: "Q ∈ S" by fact
show ?case
proof(case_tac "(S - {Q}) = {}")
assume "(S - {Q}) = {}"
with QinS have SeqQ: "S = {Q}" by auto
have "(P, S - {Q}) ∈ sumComposeSet" by fact
with SeqQ have "(P, {}) ∈ sumComposeSet" by simp
hence "P = 𝟬" apply - by(ind_cases "(P, {}) ∈ sumComposeSet", auto)
with QinS SeqQ show ?case by simp
next
assume "(S - {Q}) ≠ {}"
moreover have "(S - {Q}) ≠ {} ⟹ ∃Q' ∈ (S - {Q}). depth P ≤ depth Q' ∧ (∀R ∈ (S - {Q}). depth R ≤ depth Q')" by fact
ultimately obtain Q' where Q'inS: "Q' ∈ S - {Q}" and PQ'depth: "depth P ≤ depth Q'" and All: "∀R ∈ (S - {Q}). depth R ≤ depth Q'" by auto
show ?case
proof(case_tac "Q = Q'")
assume "Q = Q'"
with PQ'depth All QinS show ?case by auto
next
assume QineqQ': "Q ≠ Q'"
show ?case
proof(case_tac "depth Q ≤ depth Q'")
assume "depth Q ≤ depth Q'"
with QineqQ' PQ'depth All Q'inS show ?thesis by force
next
assume "¬ depth Q ≤ depth Q'"
with QineqQ' PQ'depth All Q'inS QinS show ?thesis apply auto
apply(rule_tac x=Q in bexI)
apply auto
apply(case_tac "R=Q")
apply auto
apply(erule_tac x=R in ballE)
by auto
qed
qed
qed
qed
lemma depthSubst[simp]:
fixes P :: pi
and a :: name
and b :: name
shows "depth(P[a::=b]) = depth P"
by(nominal_induct P avoiding: a b rule: pi.strong_inducts, auto)
lemma depthTransition:
fixes P :: pi
and a :: name
and b :: name
and P' :: pi
assumes Phnf: "hnf P"
shows "P ⟼a[b] ≺ P' ⟹ depth P' < depth P"
and "P ⟼a<x> ≺ P' ⟹ depth P' < depth P"
and "P ⟼τ ≺ P' ⟹ depth P' < depth P"
and "P ⟼a<νx> ≺ P' ⟹ depth P' < depth P"
proof -
assume "P ⟼a[b] ≺ P'"
thus "depth P' < depth P" using assms
by(nominal_induct rule: outputInduct, auto)
next
assume Trans: "P ⟼a<x> ≺ P'"
have Goal: "⋀P a x P'. ⟦P ⟼a<x> ≺ P'; x ♯ P; hnf P⟧ ⟹ depth P' < depth P"
proof -
fix P a x P'
assume "P ⟼a<x> ≺ P'" and "x ♯ P" and "hnf P"
thus "depth P' < depth P"
by(nominal_induct rule: inputInduct, auto)
qed
obtain y::name where yFreshP: "y ♯ P" and yFreshP': "y ♯ P'"
by(rule_tac name_exists_fresh[of "(P, P')"], auto simp add: fresh_prod)
from yFreshP' Trans have "P ⟼a<y> ≺ [(x, y)] ∙ P'" by(simp add: alphaBoundResidual)
hence "depth ([(x, y)] ∙ P') < depth P" using yFreshP Phnf by(rule Goal)
thus "depth P' < depth P" by simp
next
assume "P ⟼τ ≺ P'"
thus "depth P' < depth P" using assms
by(nominal_induct rule: tauInduct, auto simp add: uhnf_def)
next
assume Trans: "P ⟼a<νx> ≺ P'"
have Goal: "⋀P a x P'. ⟦P ⟼a<νx> ≺ P'; x ♯ P; hnf P⟧ ⟹ depth P' < depth P"
proof -
fix P a x P'
assume "P ⟼a<νx> ≺ P'" and "x ♯ P" and "hnf P"
thus "depth P' < depth P"
by(nominal_induct rule: boundOutputInduct,
auto elim: outputCases simp add: residual.inject)
qed
obtain y::name where yFreshP: "y ♯ P" and yFreshP': "y ♯ P'"
by(rule_tac name_exists_fresh[of "(P, P')"], auto simp add: fresh_prod)
from yFreshP' Trans have "P ⟼a<νy> ≺ [(x, y)] ∙ P'" by(simp add: alphaBoundResidual)
hence "depth ([(x, y)] ∙ P') < depth P" using yFreshP Phnf by(rule Goal)
thus "depth P' < depth P" by simp
qed
lemma maxExpandDepth:
fixes P :: pi
and Q :: pi
and R :: pi
assumes "R ∈ expandSet P Q"
and "hnf P"
and "hnf Q"
shows "depth R ≤ depth(P ∥ Q)"
using assms
apply(auto simp add: expandSet_def summandTransition[THEN sym] dest: depthTransition)
apply(subgoal_tac "a ≠ x")
apply(simp add: summandTransition[THEN sym])
apply(force dest: depthTransition)
apply blast
apply(subgoal_tac "a ≠ x")
apply(simp add: summandTransition[THEN sym])
apply(force dest: depthTransition)
apply blast
apply(force dest: depthTransition)
apply(force dest: depthTransition)
apply(subgoal_tac "a ≠ y")
apply(simp add: summandTransition[THEN sym])
apply(force dest: depthTransition)
apply blast
apply(subgoal_tac "a ≠ y")
apply(simp add: summandTransition[THEN sym])
apply(force dest: depthTransition)
by blast
lemma expandDepth':
fixes P :: pi
and Q :: pi
assumes Phnf: "hnf P"
and Qhnf: "hnf Q"
shows "∃R. (R, expandSet P Q) ∈ sumComposeSet ∧ depth R ≤ depth(P ∥ Q)"
proof(case_tac "expandSet P Q = {}")
assume "expandSet P Q = {}"
with Phnf Qhnf show ?thesis by(auto intro: sumComposeSet.empty)
next
assume "expandSet P Q ≠ {}"
moreover from Phnf Qhnf finiteExpand obtain R where TSC: "(R, expandSet P Q) ∈ sumComposeSet"
by(blast dest: expandComplete)
ultimately obtain T where "T ∈ expandSet P Q"
and "depth R ≤ depth T"
by(blast dest: expandDepth)
with Phnf Qhnf have "depth R ≤ depth(P ∥ Q)"
by(force dest: maxExpandDepth)
with TSC show ?thesis by blast
qed
lemma validToHnf:
fixes P :: pi
assumes "valid P"
shows "∃Q. uhnf Q ∧ valid Q ∧ Q ≡⇩e P ∧ (depth Q) ≤ (depth P)"
proof -
have MatchGoal: "⋀a b P Q. ⟦uhnf Q; valid Q; Q ≡⇩e P; depth Q ≤ depth P⟧ ⟹
∃Q. uhnf Q ∧ valid Q ∧ Q ≡⇩e [a⌢b]P ∧ depth Q ≤ depth ([a⌢b]P)"
proof -
fix a b P Q
assume Qhnf: "uhnf Q" and validQ: "valid Q" and QeqP: "Q ≡⇩e P"
and QPdepth: "depth Q ≤ depth P"
show "∃Q. uhnf Q ∧ valid Q ∧ Q ≡⇩e [a⌢b]P ∧ depth Q ≤ depth ([a⌢b]P)"
proof(case_tac "a = b")
assume "a = b"
with QeqP have "Q ≡⇩e [a⌢b]P" by(blast intro: Sym Trans equiv.Match)
with Qhnf validQ QPdepth show ?thesis by force
next
assume "a ≠ b"
hence "𝟬 ≡⇩e [a⌢b]P" by(blast intro: Sym Match')
moreover have "uhnf 𝟬" by(simp add: uhnf_def)
ultimately show ?thesis by force
qed
qed
from assms show ?thesis
proof(nominal_induct P rule: pi.strong_inducts)
case PiNil
have "uhnf 𝟬" by(simp add: uhnf_def)
moreover have "valid 𝟬" by simp
moreover have "𝟬 ≡⇩e 𝟬" by(rule Refl)
moreover have "(depth 𝟬) ≤ (depth 𝟬)" by simp
ultimately show ?case by blast
next
case(Output a b P)
have "uhnf (a{b}.P)" by(simp add: uhnf_def)
moreover have "valid(a{b}.P)" by fact
moreover have "a{b}.P ≡⇩e a{b}.P" by(rule Refl)
moreover have "(depth (a{b}.P)) ≤ (depth (a{b}.P))" by simp
ultimately show ?case by blast
next
case(Tau P)
have "uhnf (τ.(P))" by(simp add: uhnf_def)
moreover have "valid (τ.(P))" by fact
moreover have "τ.(P) ≡⇩e τ.(P)" by(rule Refl)
moreover have "(depth (τ.(P))) ≤ (depth (τ.(P)))" by simp
ultimately show ?case by blast
next
case(Input a x P)
have "uhnf (a<x>.P)" by(simp add: uhnf_def)
moreover have "valid (a<x>.P)" by fact
moreover have "a<x>.P ≡⇩e a<x>.P" by(rule Refl)
moreover have "(depth (a<x>.P)) ≤ (depth (a<x>.P))" by simp
ultimately show ?case by blast
next
case(Match a b P)
have "valid ([a⌢b]P)" by fact
hence "valid P" by simp
moreover have "valid P ⟹ ∃Q. uhnf Q ∧ valid Q ∧ Q ≡⇩e P ∧ depth Q ≤ depth P" by fact
ultimately obtain Q where Qhnf: "uhnf Q" and validQ: "valid Q" and QeqP: "Q ≡⇩e P"
and QPdepth: "depth Q ≤ depth P" by blast
thus ?case by(rule MatchGoal)
next
case(Mismatch a b P)
have "valid ([a≠b]P)" by fact
hence "valid P" by simp
moreover have "valid P ⟹ ∃Q. uhnf Q ∧ valid Q ∧ Q ≡⇩e P ∧ depth Q ≤ depth P" by fact
ultimately obtain Q where Qhnf: "uhnf Q" and validQ: "valid Q" and QeqP: "Q ≡⇩e P"
and QPdepth: "depth Q ≤ depth P" by blast
show ?case
proof(case_tac "a = b")
assume "a = b"
hence "𝟬 ≡⇩e [a≠b]P" by(blast intro: Sym Mismatch')
moreover have "uhnf 𝟬" by(simp add: uhnf_def)
ultimately show ?case by force
next
assume "a ≠ b"
with QeqP have "Q ≡⇩e [a≠b]P" by(blast intro: Sym Trans equiv.Mismatch)
with Qhnf validQ QPdepth show ?case by force
qed
next
case(Sum P Q)
have "valid(P ⊕ Q)" by fact
hence validP: "valid P" and validQ: "valid Q" by simp+
have "∃P'. uhnf P' ∧ valid P' ∧ P' ≡⇩e P ∧ (depth P') ≤ (depth P)"
proof -
have "valid P ⟹ ∃P'. uhnf P' ∧ valid P' ∧ P' ≡⇩e P ∧ (depth P') ≤ (depth P)" by fact
with validP show ?thesis by simp
qed
then obtain P' where P'hnf: "uhnf P'" and P'eqP: "P' ≡⇩e P" and validP': "valid P'"
and P'depth: "(depth P') ≤ (depth P)" by blast
have "∃Q'. uhnf Q' ∧ valid Q' ∧ Q' ≡⇩e Q ∧ (depth Q') ≤ (depth Q)"
proof -
have "valid Q ⟹ ∃Q'. uhnf Q' ∧ valid Q' ∧ Q' ≡⇩e Q ∧ (depth Q') ≤ (depth Q)" by fact
with validQ show ?thesis by simp
qed
then obtain Q' where Q'hnf: "uhnf Q'" and Q'eqQ: "Q' ≡⇩e Q" and validQ': "valid Q'"
and Q'depth: "(depth Q') ≤ (depth Q)" by blast
from P'hnf Q'hnf validP' validQ' obtain R where Rhnf: "uhnf R" and validR: "valid R"
and P'Q'eqR: "P' ⊕ Q' ≡⇩e R"
and Rdepth: "depth R ≤ depth(P' ⊕ Q')"
apply(drule_tac uhnfSum) apply assumption+ by blast
from validP' validQ' have "valid(P' ⊕ Q')" by simp
from P'eqP Q'eqQ P'Q'eqR have "P ⊕ Q ≡⇩e R" by(blast intro: Sym SumPres' Trans)
moreover from Rdepth P'depth Q'depth have "depth R ≤ depth(P ⊕ Q)" by auto
ultimately show ?case using validR Rhnf by(blast intro: Sym)
next
case(Par P Q)
have "valid(P ∥ Q)" by fact
hence validP: "valid P" and validQ: "valid Q" by simp+
have "∃P'. uhnf P' ∧ valid P' ∧ P' ≡⇩e P ∧ (depth P') ≤ (depth P)"
proof -
have "valid P ⟹ ∃P'. uhnf P' ∧ valid P' ∧ P' ≡⇩e P ∧ (depth P') ≤ (depth P)" by fact
with validP show ?thesis by simp
qed
then obtain P' where P'hnf: "uhnf P'" and P'eqP: "P' ≡⇩e P" and validP': "valid P'"
and P'depth: "(depth P') ≤ (depth P)" by blast
have "∃Q'. uhnf Q' ∧ valid Q' ∧ Q' ≡⇩e Q ∧ (depth Q') ≤ (depth Q)"
proof -
have "valid Q ⟹ ∃Q'. uhnf Q' ∧ valid Q' ∧ Q' ≡⇩e Q ∧ (depth Q') ≤ (depth Q)" by fact
with validQ show ?thesis by simp
qed
then obtain Q' where Q'hnf: "uhnf Q'" and Q'eqQ: "Q' ≡⇩e Q" and validQ': "valid Q'"
and Q'depth: "(depth Q') ≤ (depth Q)" by blast
from P'hnf Q'hnf obtain R where Exp: "(R, expandSet P' Q') ∈ sumComposeSet" and Rdepth: "depth R ≤ depth(P' ∥ Q')"
by(force dest: expandDepth' simp add: uhnf_def)
from Exp P'hnf Q'hnf have P'Q'eqR: "P' ∥ Q' ≡⇩e R" by(force intro: Expand simp add: uhnf_def)
from P'hnf Q'hnf validP' validQ' have "∀P ∈ (expandSet P' Q'). uhnf P ∧ valid P" by(blast dest: validExpand)
with Exp obtain R' where R'hnf: "uhnf R'" and validR': "valid R'"
and ReqR': "R ≡⇩e R'"
and R'depth: "depth R' ≤ depth R"
by(blast dest: expandHnf)
from P'eqP Q'eqQ P'Q'eqR ReqR' have "P ∥ Q ≡⇩e R'" by(blast intro: Sym ParPres Trans)
moreover from Rdepth P'depth Q'depth R'depth have "depth R' ≤ depth(P ∥ Q)" by auto
ultimately show ?case using validR' R'hnf by(blast dest: Sym)
next
case(Res x P)
have "valid (<νx>P)" by fact
hence validP: "valid P" by simp
moreover have "valid P ⟹ ∃Q. uhnf Q ∧ valid Q ∧ Q ≡⇩e P ∧ depth Q ≤ depth P" by fact
ultimately obtain Q where Qhnf: "uhnf Q" and validQ: "valid Q" and QeqP: "Q ≡⇩e P"
and QPDepth: "depth Q ≤ depth P" by blast
from validP show ?case
proof(nominal_induct P avoiding: x rule: pi.strong_inducts)
case PiNil
have "uhnf 𝟬" by(simp add: uhnf_def)
moreover have "valid 𝟬" by simp
moreover have "𝟬 ≡⇩e <νx>𝟬"
proof -
have "x ♯ 𝟬" by simp
thus ?thesis by(blast intro: Sym ResFresh)
qed
moreover have "depth 𝟬 ≤ depth (<νx>𝟬)" by simp
ultimately show ?case by blast
next
case(Output a b P)
have "valid(a{b}.P)" by fact
hence validP: "valid P" by simp
show ?case
proof(case_tac "x=a")
assume "x = a"
moreover have "uhnf 𝟬" by(simp add: uhnf_def)
moreover have "valid 𝟬" by simp
moreover have "𝟬 ≡⇩e <νx>x{b}.P" by(blast intro: ResOutput' Sym)
moreover have "depth 𝟬 ≤ depth(<νx>x{b}.P)" by simp
ultimately show ?case by blast
next
assume xineqa: "x ≠ a"
show ?case
proof(case_tac "x=b")
assume "x=b"
moreover from xineqa have "uhnf(<νx>a{x}.P)" by(force simp add: uhnf_def)
moreover from validP have "valid(<νx>a{x}.P)" by simp
moreover have "<νx>a{x}.P ≡⇩e <νx>a{x}.P" by(rule Refl)
moreover have "depth(<νx>a{x}.P) ≤ depth(<νx>a{x}.P)" by simp
ultimately show ?case by blast
next
assume xineqb: "x ≠ b"
have "uhnf(a{b}.(<νx>P))" by(simp add: uhnf_def)
moreover from validP have "valid(a{b}.(<νx>P))" by simp
moreover from xineqa xineqb have "a{b}.(<νx>P) ≡⇩e <νx>a{b}.P" by(blast intro: ResOutput Sym)
moreover have "depth(a{b}.(<νx>P)) ≤ depth(<νx>a{b}.P)" by simp
ultimately show ?case by blast
qed
qed
next
case(Tau P)
have "valid(τ.(P))" by fact
hence validP: "valid P" by simp
have "uhnf(τ.(<νx>P))" by(simp add: uhnf_def)
moreover from validP have "valid(τ.(<νx>P))" by simp
moreover have "τ.(<νx>P) ≡⇩e <νx>τ.(P)" by(blast intro: ResTau Sym)
moreover have "depth(τ.(<νx>P)) ≤ depth(<νx>τ.(P))" by simp
ultimately show ?case by blast
next
case(Input a y P)
have "valid(a<y>.P)" by fact
hence validP: "valid P" by simp
have "y ♯ x" by fact hence yineqx: "y ≠ x" by simp
show ?case
proof(case_tac "x=a")
assume "x = a"
moreover have "uhnf 𝟬" by(simp add: uhnf_def)
moreover have "valid 𝟬" by simp
moreover have "𝟬 ≡⇩e <νx>x<y>.P" by(blast intro: ResInput' Sym)
moreover have "depth 𝟬 ≤ depth(<νx>x<y>.P)" by simp
ultimately show ?case by blast
next
assume xineqa: "x ≠ a"
have "uhnf(a<y>.(<νx>P))" by(simp add: uhnf_def)
moreover from validP have "valid(a<y>.(<νx>P))" by simp
moreover from xineqa yineqx have "a<y>.(<νx>P) ≡⇩e <νx>a<y>.P" by(blast intro: ResInput Sym)
moreover have "depth(a<y>.(<νx>P)) ≤ depth(<νx>a<y>.P)" by simp
ultimately show ?case by blast
qed
next
case(Match a b P x)
have "valid([a⌢b]P)" by fact hence "valid P" by simp
moreover have "⋀x. valid P ⟹ ∃Q. uhnf Q ∧ valid Q ∧ Q ≡⇩e <νx>P ∧
depth Q ≤ depth(<νx>P)"
by fact
ultimately obtain Q where Qhnf: "uhnf Q" and validQ: "valid Q"
and QeqP: "Q ≡⇩e (<νx>P)"
and QPdepth: "depth Q ≤ depth(<νx>P)"
by blast
show ?case
proof(case_tac "a = b")
assume "a=b"
moreover have "Q ≡⇩e <νx>[a⌢a]P"
proof -
have "P ≡⇩e [a⌢a]P" by(blast intro: equiv.Match Sym)
hence "<νx>P ≡⇩e <νx>[a⌢a]P" by(rule ResPres)
with QeqP show ?thesis by(blast intro: Trans)
qed
moreover from QPdepth have "depth Q ≤ depth(<νx>[a⌢a]P)" by simp
ultimately show ?case using Qhnf validQ by blast
next
assume aineqb: "a≠b"
have "uhnf 𝟬" by(simp add: uhnf_def)
moreover have "valid 𝟬" by simp
moreover have "𝟬 ≡⇩e <νx>[a⌢b]P"
proof -
from aineqb have "𝟬 ≡⇩e [a⌢b]P" by(blast intro: Match' Sym)
hence "<νx>𝟬 ≡⇩e <νx>[a⌢b]P" by(rule ResPres)
thus ?thesis by(blast intro: ResNil Trans Sym)
qed
moreover have "depth 𝟬 ≤ depth(<νx>[a⌢b]P)" by simp
ultimately show ?case by blast
qed
next
case(Mismatch a b P x)
have "valid([a≠b]P)" by fact hence "valid P" by simp
moreover have "⋀x. valid P ⟹ ∃Q. uhnf Q ∧ valid Q ∧ Q ≡⇩e <νx>P ∧
depth Q ≤ depth(<νx>P)"
by fact
ultimately obtain Q where Qhnf: "uhnf Q" and validQ: "valid Q"
and QeqP: "Q ≡⇩e (<νx>P)"
and QPdepth: "depth Q ≤ depth(<νx>P)"
by blast
show ?case
proof(case_tac "a = b")
assume "a=b"
moreover have "uhnf 𝟬" by(simp add: uhnf_def)
moreover have "valid 𝟬" by simp
moreover have "𝟬 ≡⇩e <νx>[a≠a]P"
proof -
have "𝟬 ≡⇩e [a≠a]P" by(blast intro: Mismatch' Sym)
hence "<νx>𝟬 ≡⇩e <νx>[a≠a]P" by(rule ResPres)
thus ?thesis by(blast intro: ResNil Trans Sym)
qed
moreover have "depth 𝟬 ≤ depth(<νx>[a≠a]P)" by simp
ultimately show ?case by blast
next
assume aineqb: "a≠b"
have "Q ≡⇩e <νx>[a≠b]P"
proof -
from aineqb have "P ≡⇩e [a≠b]P" by(blast intro: equiv.Mismatch Sym)
hence "<νx>P ≡⇩e <νx>[a≠b]P" by(rule ResPres)
with QeqP show ?thesis by(blast intro: Trans)
qed
moreover from QPdepth have "depth Q ≤ depth(<νx>[a≠b]P)" by simp
ultimately show ?case using Qhnf validQ by blast
qed
next
case(Sum P Q x)
have "valid(P ⊕ Q)" by fact
hence validP: "valid P" and validQ: "valid Q" by simp+
have "∃P'. uhnf P' ∧ valid P' ∧ P' ≡⇩e <νx>P ∧ (depth P') ≤ (depth(<νx>P))"
proof -
have "valid P ⟹ ∃P'. uhnf P' ∧ valid P' ∧ P' ≡⇩e <νx>P ∧ (depth P') ≤ (depth (<νx>P))" by fact
with validP show ?thesis by simp
qed
then obtain P' where P'hnf: "uhnf P'" and P'eqP: "P' ≡⇩e <νx>P" and validP': "valid P'"
and P'depth: "(depth P') ≤ (depth(<νx>P))" by blast
have "∃Q'. uhnf Q' ∧ valid Q' ∧ Q' ≡⇩e <νx>Q ∧ (depth Q') ≤ (depth(<νx>Q))"
proof -
have "valid Q ⟹ ∃Q'. uhnf Q' ∧ valid Q' ∧ Q' ≡⇩e <νx>Q ∧ (depth Q') ≤ (depth(<νx>Q))" by fact
with validQ show ?thesis by simp
qed
then obtain Q' where Q'hnf: "uhnf Q'" and Q'eqQ: "Q' ≡⇩e <νx>Q" and validQ': "valid Q'"
and Q'depth: "(depth Q') ≤ (depth(<νx>Q))" by blast
from P'hnf Q'hnf validP' validQ' obtain R where Rhnf: "uhnf R" and validR: "valid R"
and P'Q'eqR: "P' ⊕ Q' ≡⇩e R"
and Rdepth: "depth R ≤ depth(P' ⊕ Q')"
apply(drule_tac uhnfSum) apply assumption+ by blast
from P'eqP Q'eqQ P'Q'eqR have "<νx>(P ⊕ Q) ≡⇩e R" by(blast intro: Sym SumPres' SumRes Trans)
moreover from Rdepth P'depth Q'depth have "depth R ≤ depth(<νx>(P ⊕ Q))" by auto
ultimately show ?case using validR Rhnf by(blast intro: Sym)
next
case(Par P Q x)
have "valid(P ∥ Q)" by fact
hence validP: "valid P" and validQ: "valid Q" by simp+
have "∃P'. uhnf P' ∧ valid P' ∧ P' ≡⇩e P ∧ (depth P') ≤ (depth P)"
proof -
obtain x::name where xFreshP: "x ♯ P" by(rule name_exists_fresh)
moreover have "⋀x. valid P ⟹ ∃P'. uhnf P' ∧ valid P' ∧ P' ≡⇩e (<νx>P) ∧ (depth P') ≤ (depth(<νx>P))" by fact
with validP obtain P' where "uhnf P'" and "valid P'" and P'eqP: "P' ≡⇩e (<νx>P)" and P'depth: "(depth P') ≤ (depth(<νx>P))" by blast
moreover from xFreshP P'eqP have "P' ≡⇩e P" by(blast intro: Trans ResFresh)
moreover with P'depth have "depth P' ≤ depth P" by simp
ultimately show ?thesis by blast
qed
then obtain P' where P'hnf: "uhnf P'" and P'eqP: "P' ≡⇩e P" and validP': "valid P'"
and P'depth: "(depth P') ≤ (depth P)" by blast
have "∃Q'. uhnf Q' ∧ valid Q' ∧ Q' ≡⇩e Q ∧ (depth Q') ≤ (depth Q)"
proof -
obtain x::name where xFreshQ: "x ♯ Q" by(rule name_exists_fresh)
moreover have "⋀x. valid Q ⟹ ∃Q'. uhnf Q' ∧ valid Q' ∧ Q' ≡⇩e (<νx>Q) ∧ (depth Q') ≤ (depth(<νx>Q))" by fact
with validQ obtain Q' where "uhnf Q'" and "valid Q'" and Q'eqQ: "Q' ≡⇩e (<νx>Q)" and Q'depth: "(depth Q') ≤ (depth(<νx>Q))" by blast
moreover from xFreshQ Q'eqQ have "Q' ≡⇩e Q" by(blast intro: Trans ResFresh)
moreover with Q'depth have "depth Q' ≤ depth Q" by simp
ultimately show ?thesis by blast
qed
then obtain Q' where Q'hnf: "uhnf Q'" and Q'eqQ: "Q' ≡⇩e Q" and validQ': "valid Q'"
and Q'depth: "(depth Q') ≤ (depth Q)" by blast
from P'hnf Q'hnf obtain R where Exp: "(R, expandSet P' Q') ∈ sumComposeSet" and Rdepth: "depth R ≤ depth(P' ∥ Q')"
by(force dest: expandDepth' simp add: uhnf_def)
from Exp P'hnf Q'hnf have P'Q'eqR: "P' ∥ Q' ≡⇩e R" by(force intro: Expand simp add: uhnf_def)
from P'hnf Q'hnf validP' validQ' have "∀P ∈ (expandSet P' Q'). uhnf P ∧ valid P" by(blast dest: validExpand)
with Exp obtain R' where R'hnf: "uhnf R'" and validR': "valid R'"
and ReqR': "R ≡⇩e R'"
and R'depth: "depth R' ≤ depth R"
by(blast dest: expandHnf)
from P'eqP Q'eqQ P'Q'eqR ReqR' have "P ∥ Q ≡⇩e R'" by(blast intro: Sym ParPres Trans)
hence ResTrans: "<νx>(P ∥ Q) ≡⇩e <νx>R'" by(rule ResPres)
from validR' R'hnf obtain R'' where R''hnf: "uhnf R''" and validR'': "valid R''" and R'eqR'': "<νx>R' ≡⇩e R''" and R''depth: "depth R'' ≤ depth(<νx>R')"
by(force dest: uhnfRes)
from ResTrans R'eqR'' have "<νx>(P ∥ Q) ≡⇩e R''" by(rule Trans)
moreover from Rdepth P'depth Q'depth R'depth R''depth have "depth R'' ≤ depth(<νx>(P ∥ Q))" by auto
ultimately show ?case using validR'' R''hnf by(blast dest: Sym)
next
case(Res y P x)
have "valid(<νy>P)" by fact hence "valid P" by simp
moreover have "⋀x. valid P ⟹ ∃Q. uhnf Q ∧ valid Q ∧ Q ≡⇩e <νx>P ∧ depth Q ≤ depth(<νx>P)"
by fact
ultimately obtain Q where Qhnf: "uhnf Q" and validQ: "valid Q" and QeqP: "Q ≡⇩e <νy>P"
and QPdepth: "depth Q ≤ depth(<νy>P)" by blast
from Qhnf validQ obtain Q' where Q'hnf: "uhnf Q'" and validQ': "valid Q'" and QeqQ': "<νx>Q ≡⇩e Q'"
and Q'Qdepth: "depth Q' ≤ depth(<νx>Q)"
by(force dest: uhnfRes)
from QeqP have "<νx>Q ≡⇩e <νx><νy>P" by(rule ResPres)
with QeqQ' have "Q' ≡⇩e <νx><νy>P" by(blast intro: Trans Sym)
moreover from Q'Qdepth QPdepth have "depth Q' ≤ depth(<νx><νy>P)" by simp
ultimately show ?case using Q'hnf validQ' by blast
next
case(Bang P x)
have "valid(!P)" by fact
hence False by simp
thus ?case by simp
qed
next
case(Bang P)
have "valid(!P)" by fact
hence False by simp
thus ?case by simp
qed
qed
lemma depthZero:
fixes P :: pi
assumes "depth P = 0"
and "uhnf P"
shows "P = 𝟬"
using assms
apply(nominal_induct P rule: pi.strong_inducts, auto simp add: uhnf_def max_def if_split)
apply(case_tac "depth pi1 ≤ depth pi2")
by auto
lemma completeAux:
fixes n :: nat
and P :: pi
and Q :: pi
assumes "depth P + depth Q ≤ n"
and "valid P"
and "valid Q"
and "uhnf P"
and "uhnf Q"
and "P ∼ Q"
shows "P ≡⇩e Q"
using assms
proof(induct n arbitrary: P Q rule: nat.induct)
case(zero P Q)
have "depth P + depth Q ≤ 0" by fact
hence Pdepth: "depth P = 0" and Qdepth: "depth Q = 0" by auto
moreover have "uhnf P" and "uhnf Q" by fact+
ultimately have "P = 𝟬" and "Q = 𝟬" by(blast intro: depthZero)+
thus ?case by(blast intro: Refl)
next
case(Suc n P Q)
have validP: "valid P" and validQ: "valid Q" by fact+
have Phnf: "uhnf P" and Qhnf: "uhnf Q" by fact+
have PBisimQ: "P ∼ Q" by fact
have IH: "⋀P Q. ⟦depth P + depth Q ≤ n; valid P; valid Q; uhnf P; uhnf Q; P ∼ Q⟧ ⟹ P ≡⇩e Q"
by fact
have PQdepth: "depth P + depth Q ≤ Suc n" by fact
have Goal: "⋀P Q Q'. ⟦depth P + depth Q ≤ Suc n; valid P; valid Q; uhnf P; uhnf Q;
P ↝[bisim] Q; Q' ∈ summands Q⟧ ⟹ ∃P' ∈ summands P. Q' ≡⇩e P'"
proof -
fix P Q Q'
assume PQdepth: "depth P + depth Q ≤ Suc n"
assume validP: "valid P" and validQ: "valid Q"
assume Phnf: "uhnf P" and Qhnf: "uhnf Q"
assume PSimQ: "P ↝[bisim] Q"
assume Q'inQ: "Q' ∈ summands Q"
thus "∃P' ∈ summands P. Q' ≡⇩e P'" using PSimQ Phnf validP PQdepth
proof(nominal_induct Q' avoiding: P rule: pi.strong_inducts)
case PiNil
have "𝟬 ∈ summands Q" by fact
hence False by(nominal_induct Q rule: pi.strong_inducts, auto simp add: if_split)
thus ?case by simp
next
case(Output a b Q' P)
have validP: "valid P" and Phnf: "uhnf P" and PSimQ: "P ↝[bisim] Q" by fact+
have PQdepth: "depth P + depth Q ≤ Suc n" by fact
have "a{b}.Q' ∈ summands Q" by fact
with Qhnf have QTrans: "Q ⟼a[b] ≺ Q'" by(simp add: summandTransition uhnf_def)
with PSimQ obtain P' where PTrans: "P ⟼a[b] ≺ P'" and P'BisimQ': "P' ∼ Q'"
by(blast dest: simE)
from Phnf PTrans have "a{b}.P' ∈ summands P" by(simp add: summandTransition uhnf_def)
moreover have "P' ≡⇩e Q'"
proof -
from validP PTrans have validP': "valid P'" by(blast intro: validTransition)
from validQ QTrans have validQ': "valid Q'" by(blast intro: validTransition)
from validP' obtain P'' where P''hnf: "uhnf P''" and validP'': "valid P''"
and P''eqP': "P'' ≡⇩e P'" and P''depth: "depth P'' ≤ depth P'"
by(blast dest: validToHnf)
from validQ' obtain Q'' where Q''hnf: "uhnf Q''" and validQ'': "valid Q''"
and Q''eqQ': "Q'' ≡⇩e Q'" and Q''depth: "depth Q'' ≤ depth Q'"
by(blast dest: validToHnf)
have "depth P'' + depth Q'' ≤ n"
proof -
from Phnf PTrans have "depth P' < depth P"
by(force intro: depthTransition simp add: uhnf_def)
moreover from Qhnf QTrans have "depth Q' < depth Q"
by(force intro: depthTransition simp add: uhnf_def)
ultimately show ?thesis using PQdepth P''depth Q''depth by simp
qed
moreover have "P'' ∼ Q''"
proof -
from P''eqP' have "P'' ∼ P'" by(rule sound)
moreover from Q''eqQ' have "Q'' ∼ Q'" by(rule sound)
ultimately show ?thesis using P'BisimQ' by(blast dest: transitive symmetric)
qed
ultimately have "P'' ≡⇩e Q''" using validP'' validQ'' P''hnf Q''hnf by(rule_tac IH)
with P''eqP' Q''eqQ' show ?thesis by(blast intro: Sym Trans)
qed
ultimately show ?case by(blast intro: Sym equiv.OutputPres)
next
case(Tau Q' P)
have validP: "valid P" and Phnf: "uhnf P" and PSimQ: "P ↝[bisim] Q" by fact+
have PQdepth: "depth P + depth Q ≤ Suc n" by fact
have "τ.(Q') ∈ summands Q" by fact
with Qhnf have QTrans: "Q ⟼τ ≺ Q'" by(simp add: summandTransition uhnf_def)
with PSimQ obtain P' where PTrans: "P ⟼τ ≺ P'" and P'BisimQ': "P' ∼ Q'"
by(blast dest: simE)
from Phnf PTrans have "τ.(P') ∈ summands P" by(simp add: summandTransition uhnf_def)
moreover have "P' ≡⇩e Q'"
proof -
from validP PTrans have validP': "valid P'" by(blast intro: validTransition)
from validQ QTrans have validQ': "valid Q'" by(blast intro: validTransition)
from validP' obtain P'' where P''hnf: "uhnf P''" and validP'': "valid P''"
and P''eqP': "P'' ≡⇩e P'" and P''depth: "depth P'' ≤ depth P'"
by(blast dest: validToHnf)
from validQ' obtain Q'' where Q''hnf: "uhnf Q''" and validQ'': "valid Q''"
and Q''eqQ': "Q'' ≡⇩e Q'" and Q''depth: "depth Q'' ≤ depth Q'"
by(blast dest: validToHnf)
have "depth P'' + depth Q'' ≤ n"
proof -
from Phnf PTrans have "depth P' < depth P"
by(force intro: depthTransition simp add: uhnf_def)
moreover from Qhnf QTrans have "depth Q' < depth Q"
by(force intro: depthTransition simp add: uhnf_def)
ultimately show ?thesis using PQdepth P''depth Q''depth by simp
qed
moreover have "P'' ∼ Q''"
proof -
from P''eqP' have "P'' ∼ P'" by(rule sound)
moreover from Q''eqQ' have "Q'' ∼ Q'" by(rule sound)
ultimately show ?thesis using P'BisimQ' by(blast dest: transitive symmetric)
qed
ultimately have "P'' ≡⇩e Q''" using validP'' validQ'' P''hnf Q''hnf by(rule_tac IH)
with P''eqP' Q''eqQ' show ?thesis by(blast intro: Sym Trans)
qed
ultimately show ?case by(blast intro: Sym equiv.TauPres)
next
case(Input a x Q' P)
have validP: "valid P" and Phnf: "uhnf P" and PSimQ: "P ↝[bisim] Q" and xFreshP: "x ♯ P" by fact+
have PQdepth: "depth P + depth Q ≤ Suc n" by fact
have "a<x>.Q' ∈ summands Q" by fact
with Qhnf have QTrans: "Q ⟼a<x> ≺ Q'" by(simp add: summandTransition uhnf_def)
with PSimQ xFreshP obtain P' where PTrans: "P ⟼a<x> ≺ P'"
and P'derQ': "derivative P' Q' (InputS a) x bisim"
by(blast dest: simE)
from Phnf PTrans have "a<x>.P' ∈ summands P" by(simp add: summandTransition uhnf_def)
moreover have "∀y ∈ supp(P', Q', x). P'[x::=y] ≡⇩e Q'[x::=y]"
proof(rule ballI)
fix y::name
assume ysupp: "y ∈ supp(P', Q', x)"
have validP': "valid(P'[x::=y])"
proof -
from validP PTrans have validP': "valid P'" by(blast intro: validTransition)
thus ?thesis by simp
qed
have validQ': "valid(Q'[x::=y])"
proof -
from validQ QTrans have validQ': "valid Q'" by(blast intro: validTransition)
thus ?thesis by simp
qed
from validP' obtain P'' where P''hnf: "uhnf P''" and validP'': "valid P''"
and P''eqP': "P'' ≡⇩e P'[x::=y]" and P''depth: "depth P'' ≤ depth(P'[x::=y])"
by(blast dest: validToHnf)
from validQ' obtain Q'' where Q''hnf: "uhnf Q''" and validQ'': "valid Q''"
and Q''eqQ': "Q'' ≡⇩e Q'[x::=y]" and Q''depth: "depth Q'' ≤ depth(Q'[x::=y])"
by(blast dest: validToHnf)
have "depth P'' + depth Q'' ≤ n"
proof -
from Phnf PTrans have "depth P' < depth P"
by(force intro: depthTransition simp add: uhnf_def)
moreover from Qhnf QTrans have "depth Q' < depth Q"
by(force intro: depthTransition simp add: uhnf_def)
ultimately show ?thesis using PQdepth P''depth Q''depth by simp
qed
moreover have "P'' ∼ Q''"
proof -
from P'derQ' have P'BisimQ': "P'[x::=y] ∼ Q'[x::=y]"
by(auto simp add: derivative_def)
from P''eqP' have "P'' ∼ P'[x::=y]" by(rule sound)
moreover from Q''eqQ' have "Q'' ∼ Q'[x::=y]" by(rule sound)
ultimately show ?thesis using P'BisimQ' by(blast dest: transitive symmetric)
qed
ultimately have "P'' ≡⇩e Q''" using validP'' validQ'' P''hnf Q''hnf by(rule_tac IH)
with P''eqP' Q''eqQ' show "P'[x::=y] ≡⇩e Q'[x::=y]" by(blast intro: Sym Trans)
qed
ultimately show ?case
apply -
apply(rule_tac x="a<x>.P'" in bexI)
apply(rule equiv.InputPres)
apply(rule ballI)
apply(erule_tac x=y in ballE)
apply(blast dest: Sym)
by(auto simp add: supp_prod)
next
case(Match a b P' P)
have "[a⌢b]P' ∈ summands Q" by fact
hence False by(nominal_induct Q rule: pi.strong_inducts, auto simp add: if_split)
thus ?case by simp
next
case(Mismatch a b P' P)
have "[a≠b]P' ∈ summands Q" by fact
hence False by(nominal_induct Q rule: pi.strong_inducts, auto simp add: if_split)
thus ?case by simp
next
case(Sum P' Q' P)
have "P' ⊕ Q' ∈ summands Q" by fact
hence False by(nominal_induct Q rule: pi.strong_inducts, auto simp add: if_split)
thus ?case by simp
next
case(Par P' Q' P)
have "P' ∥ Q' ∈ summands Q" by fact
hence False by(nominal_induct Q rule: pi.strong_inducts, auto simp add: if_split)
thus ?case by simp
next
case(Res x Q'' P)
have xFreshP: "x ♯ P" by fact
have validP: "valid P" and Phnf: "uhnf P" and PSimQ: "P ↝[bisim] Q" by fact+
have PQdepth: "depth P + depth Q ≤ Suc n" by fact
have Q''summQ: "<νx>Q'' ∈ summands Q" by fact
hence "∃a Q'. a ≠ x ∧ Q'' = a{x}.Q'"
by(nominal_induct Q rule: pi.strong_inducts, auto simp add: if_split pi.inject name_abs_eq name_calc)
then obtain a Q' where aineqx: "a ≠ x" and Q'eqQ'': "Q'' = a{x}.Q'"
by blast
with Qhnf Q''summQ have QTrans: "Q ⟼a<νx> ≺ Q'" by(simp add: summandTransition uhnf_def)
with PSimQ xFreshP obtain P' where PTrans: "P ⟼a<νx> ≺ P'" and P'BisimQ': "P' ∼ Q'"
by(force dest: simE simp add: derivative_def)
from Phnf PTrans aineqx have "(<νx>a{x}.P') ∈ summands P" by(simp add: summandTransition uhnf_def)
moreover have "a{x}.P' ≡⇩e a{x}.Q'"
proof -
have "P' ≡⇩e Q'"
proof -
from validP PTrans have validP': "valid P'" by(blast intro: validTransition)
from validQ QTrans have validQ': "valid Q'" by(blast intro: validTransition)
from validP' obtain P'' where P''hnf: "uhnf P''" and validP'': "valid P''"
and P''eqP': "P'' ≡⇩e P'" and P''depth: "depth P'' ≤ depth P'"
by(blast dest: validToHnf)
from validQ' obtain Q'' where Q''hnf: "uhnf Q''" and validQ'': "valid Q''"
and Q''eqQ': "Q'' ≡⇩e Q'" and Q'''depth: "depth Q'' ≤ depth Q'"
by(blast dest: validToHnf)
have "depth P'' + depth Q'' ≤ n"
proof -
from Phnf PTrans have "depth P' < depth P"
by(force intro: depthTransition simp add: uhnf_def)
moreover from Qhnf QTrans have "depth Q' < depth Q"
by(force intro: depthTransition simp add: uhnf_def)
ultimately show ?thesis using PQdepth P''depth Q'''depth by simp
qed
moreover have "P'' ∼ Q''"
proof -
from P''eqP' have "P'' ∼ P'" by(rule sound)
moreover from Q''eqQ' have "Q'' ∼ Q'" by(rule sound)
ultimately show ?thesis using P'BisimQ' by(blast dest: transitive symmetric)
qed
ultimately have "P'' ≡⇩e Q''" using validP'' validQ'' P''hnf Q''hnf by(rule_tac IH)
with P''eqP' Q''eqQ' show ?thesis by(blast intro: Sym Trans)
qed
thus ?thesis by(rule OutputPres)
qed
ultimately show ?case using Q'eqQ'' by(blast intro: Sym equiv.ResPres)
next
case(Bang P' P)
have "!P' ∈ summands Q" by fact
hence False by(nominal_induct Q rule: pi.strong_inducts, auto simp add: if_split)
thus ?case by simp
qed
qed
from Phnf Qhnf PQdepth validP validQ PBisimQ show ?case
apply(rule_tac summandEquiv, auto)
apply(rule Goal)
apply auto
apply(blast dest: bisimE symmetric)
by(blast intro: Goal dest: bisimE)
qed
lemma complete:
fixes P :: pi
and Q :: pi
assumes validP: "valid P"
and validQ: "valid Q"
and PBisimQ: "P ∼ Q"
shows "P ≡⇩e Q"
proof -
from validP obtain P' where validP': "valid P'" and P'hnf: "uhnf P'" and P'eqP: "P' ≡⇩e P"
by(blast dest: validToHnf)
from validQ obtain Q' where validQ': "valid Q'" and Q'hnf: "uhnf Q'" and Q'eqQ: "Q' ≡⇩e Q"
by(blast dest: validToHnf)
have "∃n. depth P' + depth Q' ≤ n" by auto
then obtain n where "depth P' + depth Q' ≤ n" by blast
moreover have "P' ∼ Q'"
proof -
from P'eqP have "P' ∼ P" by(rule sound)
moreover from Q'eqQ have "Q' ∼ Q" by(rule sound)
ultimately show ?thesis using PBisimQ by(blast intro: symmetric transitive)
qed
ultimately have "P' ≡⇩e Q'" using validP' validQ' P'hnf Q'hnf by(rule_tac completeAux)
with P'eqP Q'eqQ show ?thesis by(blast intro: Sym Trans)
qed
end